在r中的geom\u网中标记边

我对用于 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()

第一步 :创建 draw_panel 使用的函数 geomnet::GeomNet ,带线标签,如果 aes(...) 包括的映射 linelabel

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)

第2步 :创建 GeomNet2 ggproto,继承自 几何网::几何网 ,但使用修改的 功能。

GeomNet2 <- ggproto(`_class` = "GeomNet2",
                    `_inherit` = geomnet::GeomNet,
                    draw_panel = new.draw_panel)

第3步 geom_net2 函数,类似于 geomnet::geom_net

geom_net2 <- function (
  mapping = NULL, data = NULL, stat = "net", position = "identity", show.legend = NA, 
  na.rm = FALSE, inherit.aes = TRUE, layout.alg="kamadakawai", layout.par=list(), 
  directed = FALSE, fiteach=FALSE,  selfloops = FALSE, singletons = TRUE, alpha = 0.25, 
  ecolour=NULL, ealpha=NULL, arrow=NULL, arrowgap=0.01, arrowsize=1, labelon=FALSE, 
  labelcolour=NULL, labelgeom = 'text', repel = FALSE,
  vertices=NULL, ...) {

  ggplot2::layer(
    geom = GeomNet2, mapping = mapping,  data = data, stat = stat,
    position = position, show.legend = show.legend, inherit.aes = inherit.aes,
    params = list(na.rm = na.rm, layout.alg=layout.alg, layout.par=layout.par, 
                  fiteach=fiteach, labelon=labelon, labelgeom=labelgeom, ecolour = ecolour, 
                  ealpha=ealpha, arrow=arrow, arrowgap=arrowgap, directed=directed, repel=repel,
                  arrowsize=arrowsize, singletons=singletons, labelcolour=labelcolour, 
                  vertices=vertices, selfloops = selfloops,
                  ...)
  )
}

你可以用 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)

如果不是强制性的 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()