R中带有注释的多级嵌套饼图

Question

我目前无法生成特定类型的嵌套饼图。我想做一些我在以下文章中找到的这个数字附近的事情：https://pubmed.ncbi.nlm.nih.gov/32271901/

Plot i would like to generate

我在这篇文章中找到了一些我想做的事情：ggplot2 pie and donut chart on same plot

我将代码应用于我的数据并获得了这个： My current plot

还不错，但不是我想要的。

如果有人有改进当前代码或新代码的想法？

这是数据：

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

还有代码：

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

提前感谢您的回答:)！

Answer 1

在 cmets 中发布了额外信息之后，我采用了一种不同的方法，我认为它更接近于预期的结果（我猜应该是不同的答案）。

我们首先需要做的是通过拆分字符串将anticorps 列解卷积为组成抗体。因为我们在prct 列中具有矩形的相对大小，所以我们需要在取消去卷积列之前将它们转换为绝对值。

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)

然后我们可以使用donnees作为内部的主要数据框和extralabels作为环的数据框来制作饼图。

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

^{由reprex package (v1.0.0) 于 2021-04-12 创建}

Answer 2

这里是如何在 ggplot2 中做类似的事情。首先，我们获取您的数据和subcolors() 函数。

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);
}

然后，我们可以将数据绘制为矩形，并使用 ggnewscale 包为内部和外部矩形提供单独的填充比例。请注意，我们理论上可以依靠geom_col(position = "stack") 来绘制矩形，但我们希望防止内部矩形和外部矩形的分组之间不匹配。相反，我们使用cumsum(y) 预先计算顶部 y 位置作为累积值，而底部位置计算为 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

然后，我们只需添加极坐标，使其成为饼图。

g + coord_polar(theta = "y")

^{由reprex package (v1.0.0) 于 2021-04-12 创建}