Question

如何在ggplot的geom_net库中标记边缘？

library(geomnet)
library(ggplot2)

x <- structure(list(from = c("a", "b", "d", "f", "g", "e", "c", "i", 
                        "e", "h", "i", "i", "j", "j"), to = c("", "", "", "", "", "a", 
                                                              "b", "c", "d", "e", "f", "g", "h", "i"), edge_val = c(NA, NA, 
                                                                                                                    NA, NA, NA, 1.6, 2.25, 1.75, 0.95, 1.8, 3.2, 2.6, 2.95, 2.45)), .Names = c("from", 
                                                                                                                                                                                               "to", "edge_val"), class = "data.frame", row.names = c(NA, -14L
                                                                                                                                                                                               ))

ggplot(x, aes(from_id = from, to_id = to, linewidth = edge_val)) +
  geom_net(layout.alg = "fruchtermanreingold", labelgeom = "text",repel = TRUE,
           size = 4, labelon = TRUE, vjust = -1, ecolour = "grey80",
           directed = FALSE, fontsize = 4, ealpha = 0.5) +
  theme_net()

想法是将边缘值绘制为：

Answer 1

我对用于geom_net()（找到here）的代码进行了一些修改。可以这样使用：

# similar code as question, with linelabel = edge_val added to aes() & geom_net2
ggplot(x, 
       aes(from_id = from, to_id = to, linewidth = edge_val, linelabel = edge_val)) +
  geom_net2(layout.alg = "fruchtermanreingold", labelgeom = "text", repel = TRUE,
            size = 4, labelon = TRUE, vjust = -1, ecolour = "grey80",
            directed = FALSE, fontsize = 4, ealpha = 0.5) +
  theme_net()

要创建geom_net2()：

步骤1 ：创建draw_panel使用的geomnet::GeomNet函数的修改版本，如果aes(...)包含{{1}的映射，则带有行标签}。

linelabel

第2步：创建old.draw_panel <- environment(GeomNet$draw_panel)$f new.draw_panel <- old.draw_panel # convert function body to a list, for easier code chunk insertions body(new.draw_panel) <- as.list(body(new.draw_panel)) # geomnet code includes usage of %||%, which is an unexported function # (it is identical to the exported version in rlang / purrr, so you can skip # this step if you have one of those packages loaded) body(new.draw_panel) <- append(body(new.draw_panel), substitute( "%||%" <- function(a, b) {if (!is.null(a)) a else b} ), after = 1) # remove the last chunk of code, which returns a grobTree for the geom layer # (we'll add on a new grobTree later) body(new.draw_panel) <- body(new.draw_panel)[-length(body(new.draw_panel))] # define label_line as NULL body(new.draw_panel) <- append(body(new.draw_panel), substitute( label_line <- NULL )) # if aes(...) includes a mapping for linelabel, use it for label_line, positioned at the # midpoint of each line body(new.draw_panel) <- append(body(new.draw_panel), substitute( if (!is.null(data$linelabel)){ label_line.df <- subset(data, to != "") label_line.df$x <- (label_line.df$x + label_line.df$xend) / 2 label_line.df$y <- (label_line.df$y + label_line.df$yend) / 2 label_line.df$label <- label_line.df$linelabel label_line <- ggplot2::GeomText$draw_panel(label_line.df, panel_scales, coord) } )) # return a grobTree, with label_line added body(new.draw_panel) <- append(body(new.draw_panel), substitute( ggplot2:::ggname("geom_net2", grid::grobTree(edges_draw, selfies_draw, selfies_arrows, GeomPoint$draw_panel(vertices, panel_scales, coord), label_grob, label_line)) )) body(new.draw_panel) <- as.call(body(new.draw_panel)) rm(old.draw_panel) ggproto，该继承自GeomNet2，但使用修改后的geomnet::GeomNet函数。

draw_panel

第3步：创建GeomNet2 <- ggproto(`_class` = "GeomNet2", `_inherit` = geomnet::GeomNet, draw_panel = new.draw_panel)函数，该函数类似于geom_net2，但它使用geomnet::geom_net作为其几何。

GeomNet2

Answer 2

您可以使用ggplot_build对象获取文本标签的位置。您需要设置种子，以使图不会以新的布局重新绘制。

library(geomnet)
library(ggplot2)

set.seed(1)
p <- ggplot(x, aes(from_id = from, to_id = to, linewidth = edge_val)) +
  geom_net(layout.alg = "fruchtermanreingold", labelgeom = "text",repel = TRUE,
           size = 4, labelon = TRUE, vjust = -1, ecolour = "grey80",
           directed = FALSE, fontsize = 4, ealpha = 0.5) +
  theme_net()

# grab plot data
g <- ggplot_build(p)    
edgeData <- subset(g$data[[1]], !is.na(linewidth))

# draw labels
# x and y coords are mid between vertices
set.seed(1) # use the same seed
p + geom_text(data=edgeData,
              aes(x=(xend+x)/2, y=(yend+y)/2, label=linewidth), 
              inherit.aes = FALSE)

Answer 3

如果不是强制性的geomnet软件包，我们可以看一下ggraph软件包。
这里要考虑的事情：

library(tidyverse)
library(tidytext)
library(tidygraph)
library(ggraph)
library(ggrepel)

# first we have to give to ggraph data as it likes:
edges <- x[-c(1:5),]                        # edges
colnames(edges) <- c('a','b','edge_val')    # colnames

# second the nodes, taking all the nodes in the edges. You can also give them a weight.
  nodes <- rbind(data.frame(node = edges$a, n = 1),data.frame(node = edges$b, n = 1)) %>% group_by(node) %>% summarise(n = sum(n))

现在您必须避免软件包中可能出现的错误，如here所述：

# here the fix
edges$a <- match(edges$a, nodes$node)
edges$b <- match(edges$b, nodes$node)

# you have to give to the graph data in this way
tidy <- tbl_graph(nodes = nodes, edges = edges, directed = T)
tidy <- tidy %>% 
  activate(nodes) 

# lastly, the plot
set.seed(1)
ggraph(tidy, layout = "gem") + 
  geom_node_point(aes(size=1, color = 1)) +
  geom_edge_link(alpha = 0.8,aes(label = edge_val)) + 
  scale_edge_width(range = c(0.2, 2)) +
  geom_text_repel(aes(x = x, y=y , label=node), size = 6) + 
  # here some warnings about font...
  theme_graph()

在r的geom_net中标记边缘

3 个答案: