Label edges in geom_net in r - r

Question

How to label edges in ggplot's geom_net library?
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()
The idea would be to plot the edge value on the edges as:

Answer 1

I made some modifications to the code used for geom_net() (found here). It can be used like this:
# 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()
To create geom_net2():
Step 1: Create a modified version of the draw_panel function used by geomnet::GeomNet, with line labels if aes(...) includes a mapping for 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)
Step 2: Create GeomNet2 ggproto, which inherits from geomnet::GeomNet, but uses the modified draw_panel function.
GeomNet2 <- ggproto(`_class` = "GeomNet2",
`_inherit` = geomnet::GeomNet,
draw_panel = new.draw_panel)
Step 3: Create geom_net2 function, which is similar to geomnet::geom_net, except that it uses GeomNet2 as its geom.
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,
...)
)
}

Answer 2

You can use the ggplot_build object to get the positions for the text labels. You need to set the seed so that the plot is not redrawn with a new layout.
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

If it's not compulsory geomnet package, we can take a look to ggraph package.
Here something to think about:
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))
Now you have to avoid a possible bug in the package, as stated 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()