R 中带注释的多级嵌套饼图
Multiple Levels Nested PieChart with Annotation in R
我目前无法生成特定类型的嵌套饼图。我想做一些接近我在以下文章中找到的这个数字的事情：https://pubmed.ncbi.nlm.nih.gov/32271901/
Plot i would like to generate
我在这个 post 中发现了一些接近我想做的事情：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) )
预先感谢您的回答:) !
下面是如何在 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") 来绘制矩形，但我们希望防止内部和外部矩形的分组不匹配。相反，我们将顶部 y 位置预先计算为 cumsum(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 年 4 月 12 日创建
在评论中发布额外信息后，我采用了一种不同的方法，我认为它更接近预期结果（我猜应该是不同的答案）。
我们首先需要做的是通过拆分字符串将 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
我目前无法生成特定类型的嵌套饼图。我想做一些接近我在以下文章中找到的这个数字的事情：https://pubmed.ncbi.nlm.nih.gov/32271901/
Plot i would like to generate
我在这个 post 中发现了一些接近我想做的事情：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) )
预先感谢您的回答:) !
下面是如何在 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") 来绘制矩形，但我们希望防止内部和外部矩形的分组不匹配。相反，我们将顶部 y 位置预先计算为 cumsum(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 年 4 月 12 日创建在评论中发布额外信息后，我采用了一种不同的方法，我认为它更接近预期结果（我猜应该是不同的答案）。
我们首先需要做的是通过拆分字符串将 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