如何在 R 中向圆形热图添加另一个图例

How to add another legend to circular heat map in R

我想添加另一个图例,告诉我圆形热图的环代表什么(从外环到内环)。

我之前从另一个 answer 尝试过以下方法:

library(reshape)
library(ggplot2)
library(plyr)

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 (variables) 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


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)]

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)

但是,我没有得到图例,而是收到了这条错误消息:

Scale for 'y' is already present. Adding another scale for 'y', which will replace the existing scale.

有什么解决办法吗?

提前致谢!

我不太清楚你在找什么,但可能就是这样。 您最初使用 scale_y_discrete(breaks=y_breaks, labels=y_labels) 投影到 aes(x=Name, y=var2, fill=value) 中的连续变量 var2。通过将其更改为 scale_y_continuous(breaks=y_breaks, labels=y_labels),您可以获得 nba.m$variable 列出的分类标签。

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_continuous(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))

更新

我不确定你想在这里做什么 - 这些值在中心不是空白,因为那里有数据,删除 scale_y_continuous(breaks=y_breaks, labels=y_labels) 限制了 y 轴的比例,这样日期不再绘制。这就是为什么在删除该行代码后您看不到中间填充的原因。无论如何,如果这就是您要查找的内容,您需要做的是删除 scale_y_continuous(breaks=y_breaks, labels=y_labels) 并关闭 y 轴的标签,然后使用 grob 手动添加这些标签。我确信有更好的方法来完成您的需要,但这至少会让您入门。

p<-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=2.5) +
  scale_fill_gradient(low = "white", high = "steelblue") +
  ylim(c(0, 50)) +
  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))+ theme(axis.title.y=element_blank(),
        axis.text.y=element_blank(),
        axis.ticks.y=element_blank())
lab = textGrob((paste("G  MIN  PTS  FGM  FGA  FGP  FTM  FTA  FTP  X3PM X3PA X3PP ORB DRB  TRB  AST  STL  BLK  TO  PF")),
   x = unit(.1, "npc"), just = c("left"), 
   gp = gpar(fontsize = 7))

gp = ggplotGrob(p)
gp = gtable_add_rows(gp, unit(10, "grobheight", lab), -1)
gp = gtable_add_grob(gp, lab, t = -2, l = gp$layout[gp$layout$name == "panel",]$l)

grid.newpage()
grid.draw(gp)