ggraph 使填充的箭头边缘出现在图例中

Question

我正在尝试制作 EDA 历史的谱系图，用博士学位的 Institution 给边线和箭头上色。这种方法可行，但图表中的 filled 箭头在图例中出现 unfilled。有什么办法可以得到我想要的吗？

这是我的 MWE：

library(readxl)   # Read Excel Files
library(dplyr)    # A Grammar of Data Manipulation
library(here)     # A Simpler Way to Find Your Files
library(ggraph)   # An Implementation of Grammar of Graphics for Graphs and Networks
library(igraph)   # Network Analysis and Visualization

EDA_geneaology <- read_excel(here("EDA-geneaology.xlsx"))

EDA_gen <- EDA_geneaology %>%
  rename(parent = advisor, 
         child = student,
         Institution = institution) 

#' Clean up some links not to be shown
EDA_gen <- EDA_gen %>% 
  mutate(main = (child %in% c("John Tukey", "Harold Gulliksen")) ) %>% 
  filter( !(parent %in% c("Solomon Lefschetz", "James Angell")) ) %>% 
  filter( !(child %in% c("Clyde Coombs")))

EDA_graph <- graph_from_data_frame(EDA_gen[,c(1,3,2,4,6)])


ggraph(EDA_graph, layout="kk") + 
  geom_edge_link(aes(color=Institution, fill=Institution),
                 arrow = grid::arrow(type = "closed", 
                                     angle=15, 
                                     length = unit(0.15, "inches"))
                ) + 
  geom_node_point() +
  geom_node_text(aes(label = name), repel = TRUE) +
  ggtitle("Specimen of a Chart of Geneaology of EDA") + 
  theme_graph() +
  theme(legend.position = 'bottom')

这是我的图表：

编辑

这是数据：作为 link：https://www.dropbox.com/s/oq3jwvg8bto93ln/EDA-geneaology.xlsx?dl=0

和dput()

> dput(EDA_gen)
structure(list(parent = c("John Tukey", "John Tukey", "John Tukey", 
"John Tukey", "Samuel Wilks", "Frederick Mosteller", "Frederick Mosteller", 
"Frederick Mosteller", "Robert Abelson", "John Tukey", "Harold Gulliksen", 
"Harold Gulliksen", "John Tukey", "Arthur Dempster", "John Tukey", 
"John Hartigan", "Samuel Wilks", "Louis Leon Thurstone", "John Tukey", 
"Frederick Mosteller", "Louis Leon Thurstone", "Harold Gulliksen", 
"John Hartigan", "Leo Goodman", "Ledyard Tucker", "Andreas Buja", 
"Dianne Cook", "Peter Huber", "Arthur Dempster", "Frederick Foster", 
"Antony Unwin", "Antony Unwin", "John Hartigan", "Heike Hofmann"
), Institution = c("Princeton", "Princeton", "Princeton", "Princeton", 
"Princeton", "Harvard", "Harvard", "Harvard", "Yale", "Princeton", 
"Princeton", "Princeton", "Princeton", "Harvard", "Princeton", 
"Yale", "Princeton", "Chicago", "Princeton", "Harvard", "Chicago", 
"Princeton", "Yale", "Chicago", "Univ. Illinois", "Rutgers", 
"Iowa State", "ETH Zürich", "Harvard", "Trinity College", "Trinity College", 
"Augsberg", "Yale", "Iowa State"), child = c("Arthur Dempster", 
"Leo Goodman", "David Hoaglin", "Frederick Mosteller", "Frederick Mosteller", 
"Persi Diaconis", "Stephen Fienberg", "Stanley Wasserman", "Lee Wilkinson", 
"Robert Abelson", "Michael Friendly", "Howard Wainer", "Paul Velleman", 
"Richard Heiberger", "Karen Kafadar", "Jay Emerson", "Leo Goodman", 
"Harold Gulliksen", "John Hartigan", "Sanford Weisberg", "Ledyard Tucker", 
"James Ramsay", "William Eddy", "Shelby Haberman", "Peter Schönemann", 
"Dianne Cook", "Hadley Wickham", "Andreas Buja", "John Chambers", 
"Antony Unwin", "Graham Wills", "Heike Hofmann", "Heike Hofmann", 
"Hadley Wickham"), PhDyear = c(1956, 1950, 1971, 1946, 1946, 
1974, 1968, 1977, 1975, 1953, 1972, 1970, 1976, 1972, 1979, 2002, 
1950, NA, 1962, 1974, 1946, 1970, 1972, 1970, 1964, 1993, 2008, 
1980, 1966, 1982, 1992, 2000, 2000, 2008), MGD_id = c(15981, 
35023, 35266, 35033, 35033, 18747, 58815, 13739, 238317, 132728, 
72941, NA, 52468, 194419, 35276, 1380, 35023, 128919, 29486, 
13739, 194457, 171749, 35342, 59032, 220653, 18734, 145799, 18641, 
113988, 45024, 244314, 46503, 46503, 145799), main = c(FALSE, 
FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, 
FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, TRUE, FALSE, 
FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, 
FALSE, FALSE, FALSE, FALSE, FALSE, FALSE)), row.names = c(NA, 
-34L), class = c("tbl_df", "tbl", "data.frame"))

Answer 1

在 ggraph 包中，函数 geom_edge_link 会将您带到 geom_edge_path，您可以在该处找到绘制图例的参数。我添加了名称 (custom) 和参数 fill。对于 fill，您可以将设置保留为颜色，因为箭头中的颜色不会与箭头的其余部分颜色不同。

# from GeomEdgePath
draw_key_custom = function(data, params, size) {
  segmentsGrob(0.1, 0.5, 0.9, 0.5,
               gp = gpar(
                 col = alpha(data$edge_colour, data$edge_alpha),
                 fill = alpha(data$edge_colour, data$edge_alpha),  # <- I'm new!
                 lwd = data$edge_width * .pt,
                 lty = data$edge_linetype, lineend = 'butt'
               ),
               arrow = params$arrow
  )
}

现在您只需将它添加到图表中即可。

ggraph(EDA_graph, layout="kk") + 
  geom_edge_link(aes(color = Institution),
                 arrow = grid::arrow(type = "closed", 
                                     angle=15, 
                                     length = unit(0.15, "inches")),
                 key_glyph = "custom") +                           # <- I'm new!
  geom_node_point() +
  geom_node_text(aes(label = name), repel = TRUE) +
  ggtitle("Specimen of a Chart of Geneaology of EDA") + 
  theme_graph() +
  theme(legend.position = 'bottom')

ggraph 使填充的箭头边缘出现在图例中

ggraph make filled arrow edges appear in legend

r

legend

ggplot2

ggraph