看起来像甜甜圈的圆形热图

Posted 2023-02-18

【中文标题】看起来像甜甜圈的圆形热图

【英文标题】：Circular Heatmap that looks like a donut

【发布时间】：2012-12-02 23:12:49

【问题描述】：

我正在尝试使用 ggplot2 创建圆形热图，以便可以使用更多标签 围绕一个圆的圆周。我想让它看起来更像一个中间有一个空洞的甜甜圈，但同时又不会丢失任何行（它们需要被压缩）。

我所拥有的代码如下。

library(reshape)
library(ggplot2)

nba <- read.csv("http://datasets.flowingdata.com/ppg2008.csv")

nba$Name <- with(nba, reorder(Name, PTS))
nba.m <- melt(nba)
nba.m <- ddply(nba.m, .(variable), transform, value = scale(value))


p = ggplot(nba.m, aes(Name,variable)) + geom_tile(aes(fill = value), colour = "white") +           scale_fill_gradient(low = "white", high = "steelblue") 
p<-p+opts(
panel.background=theme_blank(),
axis.title.x=theme_blank(),
axis.title.y=theme_blank(),
panel.grid.major=theme_blank(),
panel.grid.minor=theme_blank(),  
axis.text.x=theme_blank(),
axis.ticks=theme_blank()
)


p = p + coord_polar() 
plot(p) 

【参考方案1】：

解决@FedericoGiorgi 的评论，而不是最初的问题。谢谢@bdemarest，您的解决方案非常有用！

拼凑一个数据框以显示标签，并妥善安排它们：

nba.labs <- subset(nba.m, variable==levels(nba.m$variable)[nlevels(nba.m$variable)])
nba.labs <- nba.labs[order(nba.labs$Name),]
nba.labs$ang <- seq(from=(360/nrow(nba.labs))/1.5, to=(1.5*(360/nrow(nba.labs)))-360, length.out=nrow(nba.labs))+80
nba.labs$hjust <- 0
nba.labs$hjust[which(nba.labs$ang < -90)] <- 1
nba.labs$ang[which(nba.labs$ang < -90)] <- (180+nba.labs$ang)[which(nba.labs$ang < -90)]

为标签添加geom_text：

p2 = ggplot(nba.m, aes(x=Name, y=var2, fill=value)) +
     geom_tile(colour="white") +
     geom_text(data=nba.labs, aes(x=Name, y=var2+1.5,
        label=Name, angle=ang, hjust=hjust), size=3) +
     scale_fill_gradient(low = "white", high = "steelblue") +
     ylim(c(0, max(nba.m$var2) + 1.5)) +
     scale_y_discrete(breaks=y_breaks, labels=y_labels) +
     coord_polar(theta="x") +
     theme(panel.background=element_blank(),
           axis.title=element_blank(),
           panel.grid=element_blank(),
           axis.text.x=element_blank(),
           axis.ticks=element_blank(),
           axis.text.y=element_text(size=5))
print(p2)

【参考方案2】：

这是一个解决方案，通过 (1) 将因子转换为数字并添加偏移量，(2) 手动指定 y 限制和 (3) 手动设置 y 轴中断和标签：

library(reshape)
library(ggplot2)
# Using ggplot2 0.9.2.1

nba <- read.csv("http://datasets.flowingdata.com/ppg2008.csv")
nba$Name <- with(nba, reorder(Name, PTS))
nba.m <- melt(nba)
nba.m <- ddply(nba.m, .(variable), transform, value = scale(value))

# Convert the factor levels to numeric + quanity to determine size of hole.
nba.m$var2 = as.numeric(nba.m$variable) + 15

# Labels and breaks need to be added with scale_y_discrete.
y_labels = levels(nba.m$variable)
y_breaks = seq_along(y_labels) + 15

p2 = ggplot(nba.m, aes(x=Name, y=var2, fill=value)) +
     geom_tile(colour="white") +
     scale_fill_gradient(low = "white", high = "steelblue") +
     ylim(c(0, max(nba.m$var2) + 0.5)) +
     scale_y_discrete(breaks=y_breaks, labels=y_labels) +
     coord_polar(theta="x") +
     theme(panel.background=element_blank(),
           axis.title=element_blank(),
           panel.grid=element_blank(),
           axis.text.x=element_blank(),
           axis.ticks=element_blank(),
           axis.text.y=element_text(size=5))


ggsave(filename="plot_2.png", plot=p2, height=7, width=7)

【讨论】：

这太棒了。我们如何也给 x 轴添加标签？

如果我们有不同长度的行怎么办？