Search code examples
rggplot2annotationspie-chart

Multiple Levels Nested PieChart with Annotation in R

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 :) !

Solution

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