如何在 r 中的 ggplot 中绘制两个半圆

Question

如何用两个不同大小的半圆（或三角形等其他形状）制作这样的图？

我研究了几个选项：另一篇文章建议使用一些 unicode 符号，但对我不起作用。如果我使用矢量图像，如何正确调整大小参数，使 2 个圆圈相互接触？

样本数据（我想让两个半圆的大小等于circle1size和circle2size）：

df = data.frame(circle1size = c(1, 3, 2),
                circle2size = c(3, 6, 5),
                middlepointposition = c(1, 2, 3))

最终有没有办法将半圆定位在不同的 y 值上，像这样对第三维进行编码？

非常感谢任何建议。

Answer 1

您要的是极坐标中的条形图。这可以在 ggplot2 中轻松完成。请注意，我们需要映射y = sqrt(count) 以获得与计数成比例的半圆面积。

df <- data.frame(x = c(1, 2),
                 type = c("Investors", "Assignees"),
                 count = c(19419, 1132))

ggplot(df, aes(x = x, y = sqrt(count), fill = type)) + geom_col(width = 1) +
  scale_x_discrete(expand = c(0,0), limits = c(0.5, 2.5)) +
  coord_polar(theta = "x", direction = -1)

必须应用进一步的样式来移除灰色背景、移除轴、更改颜色等，但这都是标准 ggplot2。

更新 1： 改进了多个国家/地区的版本。

df <- data.frame(x = rep(c(1, 2), 3),
                 type = rep(c("Investors", "Assignees"), 3),
                 country = rep(c("Japan", "Germany", "Korea"), each = 2),
                 count = c(19419, 1132, 8138, 947, 8349, 436))

df$country <- factor(df$country, levels = c("Japan", "Germany", "Korea"))

ggplot(df, aes(x=x, y=sqrt(count), fill=type)) + geom_col(width =1) +
  scale_x_continuous(expand = c(0, 0), limits = c(0.5, 2.5)) +
  scale_y_continuous(expand = c(0, 0)) +
  coord_polar(theta = "x", direction = -1) +
  facet_wrap(~country) +
  theme_void()

更新 2： 在不同位置绘制各个图。

我们可以采取一些技巧来获取各个图并将它们绘制在封闭图的不同位置。这是可行的，并且是一种通用方法，可以用任何类型的情节来完成，但在这里可能有点矫枉过正。无论如何，这是解决方案。

library(tidyverse) # for map
library(cowplot) # for draw_text, draw_plot, get_legend, insert_yaxis_grob

# data frame of country data
df <- data.frame(x = rep(c(1, 2), 3),
                 type = rep(c("Investors", "Assignees"), 3),
                 country = rep(c("Japan", "Germany", "Korea"), each = 2),
                 count = c(19419, 1132, 8138, 947, 8349, 436))

# list of coordinates
coord_list = list(Japan = c(1, 3), Germany = c(2, 1), Korea = c(3, 2))

# make list of individual plots
split(df, df$country) %>% 
  map( ~ ggplot(., aes(x=x, y=sqrt(count), fill=type)) + geom_col(width =1) +
  scale_x_continuous(expand = c(0, 0), limits = c(0.5, 2.5)) +
  scale_y_continuous(expand = c(0, 0), limits = c(0, 160)) +
  draw_text(.$country[1], 1, 160, vjust = 0) +
  coord_polar(theta = "x", start = 3*pi/2) +
  guides(fill = guide_legend(title = "Type", reverse = T)) +
  theme_void() + theme(legend.position = "none") ) -> plotlist

# extract the legend
legend <- get_legend(plotlist[[1]] + theme(legend.position = "right"))

# now plot the plots where we want them
width = 1.3
height = 1.3
p <- ggplot() + scale_x_continuous(limits = c(0.5, 3.5)) + scale_y_continuous(limits = c(0.5, 3.5))
for (country in names(coord_list)) {
  p <- p + draw_plot(plotlist[[country]], x = coord_list[[country]][1]-width/2,
                     y = coord_list[[country]][2]-height/2,
                     width = width, height = height)  
}
# plot without legend
p

# plot with legend
ggdraw(insert_yaxis_grob(p, legend))

更新 3： 完全不同的方法，使用 ggforce 包中的 geom_arc_bar()。

library(ggforce)
df <- data.frame(start = rep(c(-pi/2, pi/2), 3),
                 type = rep(c("Investors", "Assignees"), 3),
                 country = rep(c("Japan", "Germany", "Korea"), each = 2),
                 x = rep(c(1, 2, 3), each = 2),
                 y = rep(c(3, 1, 2), each = 2),
                 count = c(19419, 1132, 8138, 947, 8349, 436))

r <- 0.5
scale <- r/max(sqrt(df$count))

ggplot(df) + 
  geom_arc_bar(aes(x0 = x, y0 = y, r0 = 0, r = sqrt(count)*scale,
                   start = start, end = start + pi, fill = type),
               color = "white") +
  geom_text(data = df[c(1, 3, 5), ],
            aes(label = country, x = x, y = y + scale*sqrt(count) + .05),
            size =11/.pt, vjust = 0)+ 
  guides(fill = guide_legend(title = "Type", reverse = T)) +
  xlab("x axis") + ylab("y axis") +
  coord_fixed() +
  theme_bw()

Answer 2

如果你不需要 ggplot2 地图美学除了 x 和 y 你可以试试egg::geom_custom，

# devtools::install_github("baptiste/egg")
library(egg)
library(grid)
library(ggplot2)

d = data.frame(r1= c(1,3,2), r2=c(3,6,5), x=1:3, y=1:3)
gl <- Map(mushroomGrob, r1=d$r1, r2=d$r2, gp=list(gpar(fill=c("bisque","maroon"), col="white")))
d$grobs <- I(gl)

ggplot(d, aes(x,y)) + 
  geom_custom(aes(data=grobs), grob_fun=I) +
  theme_minimal()

使用以下 grob，

mushroomGrob <- function(x=0.5, y=0.5, r1=0.2, r2=0.1, scale = 0.01, angle=0, gp=gpar()){
grob(x=x,y=y,r1=r1,r2=r2, scale=scale, angle=angle, gp=gp , cl="mushroom")
}

preDrawDetails.mushroom <- function(x){
  pushViewport(viewport(x=x$x,y=x$y))
}
postDrawDetails.mushroom<- function(x){
  upViewport()
}
drawDetails.mushroom <- function(x, recording=FALSE, ...){
  th2 <- seq(0,pi, length=180)
  th1 <- th2 + pi
  d1 <- x$r1*x$scale*cbind(cos(th1+x$angle*pi/180),sin(th1+x$angle*pi/180))
  d2 <- x$r2*x$scale*cbind(cos(th2+x$angle*pi/180),sin(th2+x$angle*pi/180))
  grid.polygon(unit(c(d1[,1],d2[,1]), "snpc")+unit(0.5,"npc"), 
              unit(c(d1[,2],d2[,2]), "snpc")+unit(0.5,"npc"),
              id=rep(1:2, each=length(th1)), gp=x$gp)
}



# grid.newpage()
# grid.draw(mushroomGrob(gp=gpar(fill=c("bisque","maroon"), col=NA)))