创建极坐标热图，但留一个扇形空间来注释每个环使用R表示的含义

问题描述

我想创建一个极地热图，类似于柳叶刀论文“ 1985年至2019年200个国家和地区的学龄儿童和青少年的身高和身体质量指数轨迹： 2181项基于人口的研究，共有6500万参与者”：

我很欣赏这样的想法，即通过创建极坐标热图的扇形开口（手动圈出红色）来注释每一圈戒指代表的年龄（5至19岁）。以下将5-19称为 Y轴标签。

下面是@Cyrus Mohammadian中描述how to arrange the positions of Y-AXIS LABELS of polar heatmaps的代码。我在下面复制了Cyrus Mohammadian的代码：

library(grid)
library(gtable)
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)]

p<-ggplot(nba.m,aes(x=Name,y=var2,fill=value)) +
  geom_tile(colour="white") +
  geom_text(data=nba.labs,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)

这是结果图：

Y轴标签放置在热图的底部，而不是像柳叶刀纸那样紧挨着每层环放置。因此，我问是否有可能修改赛勒斯·穆罕默德（Cyrus Mohammadian）的图，以使Y轴标签位于环的每一层旁边，而不是显示在热图之外？另外，最好控制扇形开口的大小，以便根据Y轴标签文本的长度进行自定义。

第二个请求是将颜色图例放置在热图的中心并使其弯曲。下图显示了一个示例，该示例来自“中国儿童和青少年的传染病：2008年至2017年国家监控数据分析”论文的图3：

请注意，颜色图例位于中心并弯曲。该怎么做？

谢谢。

解决方法

这是一些示例代码，说明如何成形图例等形状并将其添加到绘图中。由于与极坐标有关的annotation_custom()受到一些限制，我决定使用github的拼凑版开发版本来使用新的inset_element()函数（devtools::install_github("thomasp85/patchwork")）。

library(ggplot2)
library(patchwork)

df <- reshape2::melt(volcano[1:20,1:20])
breaks <- scales::extended_breaks()(df$value)
breaks <- scales::discard(breaks,range(df$value))

main <- ggplot(df,aes(Var1,Var2,fill = value)) +
  geom_tile() +
  scale_y_continuous(limits = c(-20,NA)) +
  guides(fill = "none") +
  coord_polar()


legend <- ggplot() +
  geom_tile(
    aes( 
    x = seq(min(df$value),max(df$value),length.out = 255),y = 1,fill = after_stat(x)
    )
  ) +
  annotate(
    "text",x = breaks,y = -0.1,label = breaks,size = 3
  ) +
  annotate(
    "segment",xend = breaks,y = 0.5,yend = 0.7,colour = "white",size = 1
  ) +
  annotate(
    "segment",y = 1.5,yend = 1.3,size = 1
  ) +
  guides(fill = "none") +
  scale_y_continuous(limits = c(-2,2)) +
  scale_x_continuous(expand = c(0.1,0)) +
  coord_polar() +
  theme_void()

legend <- ggplotGrob(legend)

main + inset_element(legend,0.3,0.7,0.7) &
  theme(plot.background = element_blank())

^{由reprex package（v0.3.0）于2020-11-06创建}