r - r 中 geom_net 中的标签边

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 步:创建 geomnet::GeomNet 使用的 draw_panel 函数的修改版本，如果 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，它继承自geomnet::GeomNet，但使用修改后的draw_panel 功能。

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

第三步:创建geom_net2函数，与geomnet::geom_net类似，只是使用了GeomNet2 作为它的 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,
                  ...)
  )
}