9

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

在此处输入图像描述

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

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

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

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

非常感谢任何建议。

4

2 回答 2

14

您要的是极坐标中的条形图。这可以在 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：完全不同的方法，使用geom_arc_bar()ggforce 包。

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

在此处输入图像描述

于 2017-11-26T05:48:07.233 回答
5

如果您不需要 x 和 y 以外的 ggplot2 地图美学，您可以尝试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)))
于 2017-11-26T21:38:18.553 回答