Label edges in geom_net in 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,
                  ...)
  )
}