向 geom_polygon ggplot 添加线段

Question

我有一个

data.frame

，其中每一行定义一个组的组成，我想将它们全部绘制为笛卡尔平面上的饼图。

这是示例构图

data.frame

：

library(dplyr)
set.seed(1)
composition.df <- data.frame(x = runif(10, 0, 100), y = runif(10, 0, 100),
                             y.a_1 = as.integer(runif(10, 0, 100)), y.a_2 = as.integer(runif(10, 0, 100)), y.a_3 = as.integer(runif(10, 0, 100)), y.a_4 = as.integer(runif(10, 0, 100)),
                             y.b_1 = as.integer(runif(10, 0, 100)), y.b_2 = as.integer(runif(10, 0, 100)), y.b_3 = as.integer(runif(10, 0, 100)), y.b_4 = as.integer(runif(10, 0, 100)),
                             o.a_1 = as.integer(runif(10, 0, 100)), o.a_3 = as.integer(runif(10, 0, 100)), o.a_4 = as.integer(runif(10, 0, 100)),
                             o.b_1 = as.integer(runif(10, 0, 100)), o.b_3 = as.integer(runif(10, 0, 100)), o.b_4 = as.integer(runif(10, 0, 100))) %>%
  dplyr::mutate(size = runif(10, 0.002, 0.01)*(y.a_1 + y.a_2 + y.a_3 + y.a_4 + y.b_1 + y.b_2 + y.b_3 + y.b_4 + o.a_1 + o.a_3 + o.a_4 + o.b_1 + o.b_3 + o.b_4))

每个组/饼被分配到三个类别之一：

composition.df$class <- sample(c("A", "B", "C"), nrow(composition.df), replace = T)

此外，一些组/饼图是通过边/线段连接的。在这里，我创建了一个示例边缘

data.frame

:

edge.idx.df <- t(combn(1:nrow(composition.df), 2)) %>% as.data.frame() %>%
  filter(V1 != V2) %>%
  sample_n(20)

edge.df <- do.call(rbind, lapply(1:nrow(edge.idx.df), function(i)
  data.frame(xstart = composition.df$x[edge.idx.df$V1[i]], ystart = composition.df$y[edge.idx.df$V1[i]], xend = composition.df$x[edge.idx.df$V2[i]], yend = composition.df$y[edge.idx.df$V2[i]])
)) %>% mutate(weight = runif(nrow(edge.idx.df), 0, 1))

为了将

composition.df

绘制为饼图，我正在关注这篇文章，其中我将

composition.df

转换为多边形

data.frame

：

composition2polygon <- function(x, y, size, samples, n, rownum, class)
{
  angles <- c(0,2*pi*cumsum(n)/sum(n))
  do.call("rbind",Map(function(a1,a2,s){
    xvals <- c(0,sin(seq(a1,a2,len=30))*size,0)+x
    yvals <- c(0, cos(seq(a1,a2,len=30))*size,0)+y
    data.frame(x=xvals,y=yvals,sample=s,rownum=rownum,class=class)
  }, head(angles,-1),tail(angles,-1),samples))
}

polygon.df <- composition.df %>%
  mutate(r = row_number()) %>%
  rowwise() %>%
  group_map(~ with(.x, composition2polygon(x, y,
                                           size, c("y.a_1", "y.a_2", "y.a_3", "y.a_4", "y.b_1", "y.b_2", "y.b_3", "y.b_4", "o.a_1", "o.a_3", "o.a_4", "o.b_1", "o.b_3", "o.b_4"),
                                           c(y.a_1, y.a_2, y.a_3, y.a_4, y.b_1, y.b_2, y.b_3, y.b_4, o.a_1, o.a_3, o.a_4, o.b_1, o.b_3, o.b_4), r, class))) %>%
  bind_rows() %>%
  mutate(animal = gsub("\\.a","",sample) %>% gsub("\\.b","",.)) %>% unique()

并将

sample

、

animal

和

class

列设置为

factor

，以便对它们进行颜色编码

polygon.df$sample <- factor(polygon.df$sample, levels = c("y.a_1", "y.a_2", "y.a_3", "y.a_4", "y.b_1", "y.b_2", "y.b_3", "y.b_4", "o.a_1", "o.a_3", "o.a_4", "o.b_1", "o.b_3", "o.b_4"))
polygon.df$animal <- factor(polygon.df$animal, levels = c("y_1", "y_2", "y_3", "y_4", "o_1", "o_3", "o_4"))
polygon.df$population <- factor(gsub("^y\\.","",polygon.df$sample) %>% gsub("^o\\.","",.) %>% gsub("_\\d+$","",.),levels=c("a","b"))
polygon.df$class <- factor(polygon.df$class,levels=c("A","B","C"))

仅绘制

polygons

效果很好：

library(ggplot2)
ggplot(polygon.df, aes(x, y, color = class, fill = animal, group = interaction(sample, rownum))) +
  geom_polygon(linewidth = 1, linetype = "dotted") +
  scale_fill_manual(values = c(y_1="#66C2A5", y_2="#FC8D62", y_3="#8DA0CB", y_4="#E78AC3", o_1="#A6D854", o_3="#FFD92F", o_4="#E5C494")) +
  scale_color_manual(values = c(A="blue", B="red", C="green")) +
  guides(pattern = guide_legend(override.aes = list(fill = "white"))) + coord_equal() + theme_void()

但是如果我尝试用这个添加

edges

：

ggplot(polygon.df, aes(x, y, color = class, fill = animal, group = interaction(sample, rownum))) +
  geom_polygon(linewidth = 1, linetype = "dotted") +
  geom_segment(aes(x = edge.df$xstart, y = edge.df$ystart, xend = edge.df$xend, yend = edge.df$yend),
               color = "darkgray", linewidth = edge.df$weight, alpha = 0.1, inherit.aes = F) +
  scale_fill_manual(values = c(y_1="#66C2A5", y_2="#FC8D62", y_3="#8DA0CB", y_4="#E78AC3", o_1="#A6D854", o_3="#FFD92F", o_4="#E5C494")) +
  scale_color_manual(values = c(A="blue", B="red", C="green")) +
  guides(pattern = guide_legend(override.aes = list(fill = "white"))) + coord_equal() + theme_void()

我收到此错误：

Error in `geom_segment()`:
! Problem while computing aesthetics.
ℹ Error occurred in the 2nd layer.
Caused by error in `check_aesthetics()`:
! Aesthetics must be either length 1 or the same as the data (4340)
✖ Fix the following mappings: `x`, `y`, `xend`, and `yend`
Run `rlang::last_trace()` to see where the error occurred.

知道如何添加

edges

吗？

Answer 1

不要使用

edge.df$...

将列传递给美学，而是使用

data=

参数并摆脱

edge.df$...

:

library(ggplot2)

ggplot(
  polygon.df,
  aes(x, y,
    color = class, fill = animal,
    group = interaction(sample, rownum)
  )
) +
  geom_polygon(linewidth = 1, linetype = "dotted") +
  geom_segment(
    data = edge.df,
    aes(
      x = xstart, y = ystart, xend = xend, yend = yend,
      linewidth = weight
    ),
    color = "darkgray", alpha = 0.1, inherit.aes = FALSE
  ) +
  scale_fill_manual(
    values = c(
      y_1 = "#66C2A5", y_2 = "#FC8D62",
      y_3 = "#8DA0CB", y_4 = "#E78AC3",
      o_1 = "#A6D854", o_3 = "#FFD92F",
      o_4 = "#E5C494"
    )
  ) +
  scale_color_manual(
    values = c(A = "blue", B = "red", C = "green")
  ) +
  coord_equal() +
  theme_void()