Multiple Levels Nested PieChart with Annotation in R

Question

I'm currently stuck to generate a specific kind of nested piechart. I would like to do something near of this figure I found in the following article : https://pubmed.ncbi.nlm.nih.gov/32271901/

Plot i would like to generate

I found something near of what I would like to do in this post : ggplot2 pie and donut chart on same plot

I applied the code to my data and obtain this : My current plot

It's not bad but not exactly what I want.

If anyone has an idea to improve the current code or a new one maybe ?

Here is the data :

donnnes <- structure(list(marquage = c("1 Pos", "1 Pos", "1 Pos", "2 Pos", 
"2 Pos", "2 Pos", "3 Neg", "3 Pos"), anticorps = c("TIM3", "LAG3", 
"PD1", "PD1/TIM3", "PD1/LAG3", "TIM3/LAG3", "PD1-/LAG3-/TIM3-", 
"PD1/LAG3/TIM3"), prct = c(2, 2, 18, 8, 8, 10, 40, 12)), class = c("tbl_df", 
"tbl", "data.frame"), row.names = c(NA, -8L))

And the code :

# Libraries
library(readr)
library(ggplot2) 

# Functions
donuts_plot <- function(
  panel = runif(3), # counts
  pctr = c(.5,.2,.9), # percentage in count
  legend.label='',
  cols = c('chartreuse', 'chocolate','deepskyblue'), # colors
  outradius = 1, # outter radius
  radius = .7,   # 1-width of the donus 
  add = F,
  innerradius = .5, # innerradius, if innerradius==innerradius then no suggest line
  legend = F,
  pilabels=F,
  legend_offset=.25, # non-negative number, legend right position control
  borderlit=c(T,F,T,T)
){
  par(new=add)
  if(sum(legend.label=='')>=1) legend.label=paste("Series",1:length(pctr))
  if(pilabels){
    pie(panel, col=cols,border = borderlit[1],labels = legend.label,radius = outradius)
  }
  panel = panel/sum(panel)
  
  pctr2= panel*(1 - pctr)
  pctr3 = c(pctr,pctr)
  pctr_indx=2*(1:length(pctr))
  pctr3[pctr_indx]=pctr2
  pctr3[-pctr_indx]=panel*pctr
  cols_fill = c(cols,cols)
  cols_fill[pctr_indx]='white'
  cols_fill[-pctr_indx]=cols
  par(new=TRUE)
  pie(pctr3, col=cols_fill,border = borderlit[2],labels = '',radius = outradius)
  par(new=TRUE)
  pie(panel, col='white',border = borderlit[3],labels = '',radius = radius)
  par(new=TRUE)
  pie(1, col='white',border = borderlit[4],labels = '',radius = innerradius)
  if(legend){
    # par(mar=c(5.2, 4.1, 4.1, 8.2), xpd=TRUE)
    legend("topright",inset=c(-legend_offset,0),legend=legend.label, pch=rep(15,'.',length(pctr)), 
           col=cols,bty='n')
  }
  par(new=FALSE)
}

subcolors <- function(.dta,main,mainCol){
  tmp_dta = cbind(.dta,1,'col')
  tmp1 = unique(.dta[[main]])
  for (i in 1:length(tmp1)){
    tmp_dta$"col"[.dta[[main]] == tmp1[i]] = mainCol[i]
  }
  u <- unlist(by(tmp_dta$"1",tmp_dta[[main]],cumsum))
  n <- dim(.dta)[1]
  subcol=rep(rgb(0,0,0),n);
  for(i in 1:n){
    t1 = col2rgb(tmp_dta$col[i])/256
    subcol[i]=rgb(t1[1],t1[2],t1[3],1/(1+u[i]))
  }
  return(subcol);
}

# Aggregate data
donnees=donnees[order(donnees$marquage,donnees$prct),]
arr=aggregate(prct~marquage,donnees,sum)

# Color choice 
mainCol <- c("dodgerblue4", "deeppink3", "forestgreen", "red3")

# Plot 
donuts_plot(donnees$prct,rep(1,8),donnees$anticorps,
            cols=subcolors(donnees,"marquage",mainCol),
            legend=F,pilabels = T,borderlit = rep(F,4) )

donuts_plot(arr$prct,rep(1,4),arr$marquage,
            cols=mainCol,pilabels=F,legend=T,legend_offset=-.02,
            outradius = .71,radius = .0,innerradius=.0,add=T,
            borderlit = rep(F,4) )

Thank you in advance for your answers :) !

Can you describe for us in what way exactly you'd like your pie chart to be more like the example pie chart? — teunbrand, Apr 12 '21 at 12:14
@teunbrand I would like to get the red, green and blue circles like in the article in place of the current annotation with the text. It would be easier to read when we have multiple plots to compare. — EvanS, Apr 12 '21 at 14:09
Right, so just using a legend for the fill colours of the outer circles instead of annotating it with text? Or do they also need to be thinner like the example? — teunbrand, Apr 12 '21 at 14:13
Hum not exactly, sorry I should have give more detail. I would like to keep the piechart at the center with 1 Pos / 2 Pos / 3 Pos / 3 Neg but for the extra circle, instead of the subdivision of the blue color for 1Pos in different subcolors i would like an annotation with the marker (TIM3 or PD1 or LAG3) which covers the area concerned according to its proportion. It way more understandable by looking the plot generated by the authors. I suppose my data should be formatted in an other form to perform something like this... — EvanS, Apr 12 '21 at 16:00

score 1 · Answer 1 · answered Apr 12 '21 at 15:04

Here is how to do a similar thing in ggplot2. First, we take your data and subcolors() function.

library(ggplot2) 
library(ggnewscale)

donnees <- structure(list(
  marquage = c("1 Pos", "1 Pos", "1 Pos", "2 Pos", 
               "2 Pos", "2 Pos", "3 Neg", "3 Pos"), 
  anticorps = c("TIM3", "LAG3", 
                "PD1", "PD1/TIM3", "PD1/LAG3", "TIM3/LAG3", "PD1-/LAG3-/TIM3-", 
                "PD1/LAG3/TIM3"), prct = c(2, 2, 18, 8, 8, 10, 40, 12)
), class = c("tbl_df", "tbl", "data.frame"), row.names = c(NA, -8L))

subcolors <- function(.dta,main,mainCol){
  tmp_dta = cbind(.dta,1,'col')
  tmp1 = unique(.dta[[main]])
  for (i in 1:length(tmp1)){
    tmp_dta$"col"[.dta[[main]] == tmp1[i]] = mainCol[i]
  }
  u <- unlist(by(tmp_dta$"1",tmp_dta[[main]],cumsum))
  n <- dim(.dta)[1]
  subcol=rep(rgb(0,0,0),n);
  for(i in 1:n){
    t1 = col2rgb(tmp_dta$col[i])/256
    subcol[i]=rgb(t1[1],t1[2],t1[3],1/(1+u[i]))
  }
  return(subcol);
}

Then, we can can draw the data as rectangles and use the ggnewscale package to give separate fill scales for the inner and outer rectangles. Note that we in theory could rely on geom_col(position = "stack") to draw the rectangles, but we want to prevent mismatches between the groupings of the inner and outer rectangles. Instead, we precalculate the top y-positions as cumulative values with cumsum(y), whereas the bottom positions are calculated as cumsum(y) - y.

# Color choice 
mainCol <- c("dodgerblue4", "deeppink3", "forestgreen", "red3")
subcol <- setNames(subcolors(donnees, "marquage", mainCol), donnees$anticorps)

g <- ggplot(donnees) +
  geom_rect(
    aes(ymin = cumsum(prct) - prct, ymax = cumsum(prct), 
        xmin = 0, xmax = 1, fill = marquage),
  ) +
  # Insert first fill scale here
  scale_fill_manual(values = mainCol) +
  # Declare that further fill scales should be on a new scale
  new_scale_fill() +
  geom_rect(
    aes(ymin = cumsum(prct) - prct, ymax = cumsum(prct), 
        xmin = 1.25, xmax = 1.5, fill = anticorps)
  ) +
  # Use second fill scale here
  scale_fill_manual(values = subcol, breaks = names(subcol)) +
  theme_void()

g

Then, we just add polar coordinates which makes it a pie chart.

g + coord_polar(theta = "y")

^{Created on 2021-04-12 by the reprex package (v1.0.0)}

score 0 · Accepted Answer · answered Apr 12 '21 at 16:42

After the extra information posted in the comments, I've come to a different approach which I think more closely resembles the expected outcome (and I guessed should have been a different answer).

What we need to do first is to deconvolute the anticorps column to the constituent antibodies, by splitting the strings. Because we have relative sizes of rectangles in the prct column, we need to convert these to absolutes before unnesting the deconvoluted column.

library(ggplot2) 
library(ggnewscale)

donnees <- structure(list(
  marquage = c("1 Pos", "1 Pos", "1 Pos", "2 Pos", 
               "2 Pos", "2 Pos", "3 Neg", "3 Pos"), 
  anticorps = c("TIM3", "LAG3", 
                "PD1", "PD1/TIM3", "PD1/LAG3", "TIM3/LAG3", "PD1-/LAG3-/TIM3-", 
                "PD1/LAG3/TIM3"), prct = c(2, 2, 18, 8, 8, 10, 40, 12)
), class = c("tbl_df", "tbl", "data.frame"), row.names = c(NA, -8L))

donnees <- dplyr::mutate(
  donnees,
  # Pre-compute locations
  max = cumsum(prct),
  min = cumsum(prct) - prct,
  # Labels as list-column
  labels = strsplit(anticorps, "/")
)
donnees$labels[[7]] <- character(0) # Triple negative should have no labels

extralabels <- tidyr::unnest(donnees, labels)

Then we can make a piechart using donnees as the main dataframe of the inner part and the extralabels dataframe for the rings.

mainCol <- c("dodgerblue4", "deeppink3", "forestgreen", "red3")

# The width of an extra ring
labelsize <- 0.2

ggplot(donnees, aes(ymin = min, ymax = max)) +
  geom_rect(
    aes(xmin = 0, xmax = 1, fill = marquage),
  ) +
  # Insert first fill scale here
  scale_fill_manual(values = mainCol) +
  # Declare that further fill scales should be on a new scale
  new_scale_fill() +
  geom_rect(
    aes(xmin = match(labels, unique(labels)) * labelsize + 1.05 - labelsize, 
        xmax = after_stat(xmin + labelsize * 0.75),
        fill = labels),
    data = extralabels
  ) +
  # Use second fill scale here
  scale_fill_discrete() +
  theme_void() +
  coord_polar(theta = "y")

^{Created on 2021-04-12 by the reprex package (v1.0.0)}

Thank you so much ! This is perfect :) ! – EvanS Apr 12 '21 at 20:18 — EvanS, Apr 12 '21 at 20:18

Multiple Levels Nested PieChart with Annotation in R

2 Answers2