Creating polar heatmap but leaving a fan-shaped space to annotate what each ring indicates using R

Question

I would like to create a polar heatmap like the heatmap from the Lancet paper "Height and body-mass index trajectories of school-aged children and adolescents from 1985 to 2019 in 200 countries and territories: a pooled analysis of 2181 population-based studies with 65 million participants":

I appreciate the idea of annotating the age each layer of ring represents (age 5 to 19 years) by creating a fan-shaped opening of the polar heatmap (manually circled in red). I refer to 5-19 as the Y-AXIS LABELS hereafter.

Below is the code from @Cyrus Mohammadian describing how to arrange the positions of Y-AXIS LABELS of polar heatmaps. I replicate Cyrus Mohammadian's code below:

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

This is the resultant figure:

Y-AXIS LABELS are placed at the bottom of the heatmap instead of being positioned immediately next to each layer of ring like the Lancet paper. I therefore ask if it is possible to modify Cyrus Mohammadian's plot so that Y-AXIS LABELS are positioned next to each layer of the ring instead of being presented outside of the heatmap? In addition, it is preferrable that we can control the size of the fan-shaped opening so that we can customize according to length of the Y-AXIS LABEL texts.

A second request is to place the color legend in the center of the heatmap and make it curved. An example is illustrated in the figure below, which is from Fig 3 of the paper "Infectious diseases in children and adolescents in China: analysis of national surveillance data from 2008 to 2017":

Note that the color legend is centrally located and curved. How this could be done?

Thank you.

Answer 1

Here is some example code for how you can shape something like a legend and add it to your plot. Due to some restrictions on annotation_custom() in relation to polar coordinates, I decided to use the devel version of patchwork from github to use the new inset_element() function (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", x = breaks, xend = breaks, y = 0.5, yend = 0.7, 
    colour = "white", size = 1
  ) +
  annotate(
    "segment", x = breaks, xend = breaks, y = 1.5, yend = 1.3, 
    colour = "white", 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.3, 0.7, 0.7) &
  theme(plot.background = element_blank())

^{Created on 2020-11-06 by the reprex package (v0.3.0)}