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

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

2 个答案: