#R #ggraph #visNetwork

ggraph动态可视化方案¶

约 1020 个字 156 行代码预计阅读时间 5 分钟

ggraph到目前版本(v2.2.1)，依然不支持直接转plotly进行动态可视化网络图，此路虽然走不通，但是可以曲线救国，这里有几种平替方案，主要思路如下：

获取ggraph对象的绘图数据，然后用直接用visNetwork进行动态网络的绘制即可，这和直接一开始就用visNetwork绘制网络有何区别呢？主要考虑如下：

visNetwork不支持高清晰保存方案(pdf/png)，仅支持html的保存，但是ggraph支持高精度图像保持
ggraph可视化更丰富方便，支持更多的自定义，写一个转化函数将已有的ggraph进行visNetwork转化，既保证了保存结果的清晰度，也保证了结果的动态效果。

这里尝试过以下几种方案：

visNetwork方案¶

首先需要获取ggraph对象中的网络数据(以下代码中的ggraph_obj变量)，即边和点的数据，有如下两个不同的获取方案，结果也不同：

方案1：基于ggplot2的内置函数和数据集获取

S

library(igraph)
library(ggraph)
library(ggplot2)
###提取数据
dt_lst=ggplot_build(ggraph_obj)$data
g <- ggplot_build(a$plot)
g_node_dt=dt_lst[[3]]
g_edge_dt=dt_lst[[1]]%>%distinct(.,from,to,.keep_all = T)
##对数据做一些修改，否则效果达不到预期
nodes=igraph_dt_lst$nodes%>%mutate(color=g_node_dt$colour,shape=g_node_dt$shape)
nodes$shape=NULL
nodes$size=20
nodes$color=scales::alpha(nodes$color,0.99)
edges=igraph_dt_lst$edges%>%mutate(value=g_edge_dt$edge_width,color=g_edge_dt$edge_colour)
edges$color=scales::alpha(edges$color,0.5)
edges$value=scales::rescale(edges$value,10,50)
edges$value=NULL
###visNetwork可视化

visNetwork::visIgraph(igraph_obj,layout = "layout_with_kk",type = "full") %>%
  visOptions(highlightNearest = list(enabled = T, hover = F,
                                     degree = 1,
                                     hideColor = "rgba(0,0,0,0.05)",
                                     labelOnly = FALSE),
             nodesIdSelection = T,
             autoResize = T) %>%
  visPhysics(stabilization = F,solver = "barnesHut")%>%
  visNodes(
    font = list(size = 40, multi = "html"),
    # color = list(background = "white", border = NA)
  ) %>%
  visEdges(dashes = F,
           color=list(
             color=scales::alpha(c("grey25"),0.3),
             highlight = "red", hover = "blue")  ###Hover and Highlight parameters does work! 
  )%>%
  visInteraction(hover = T)

方案2：attributes函数提取数据

S

library(igraph)
library(ggraph)
library(ggplot2)
###提取ggraph对象中的igraph子对象
igraph_obj=attributes(ggraph_obj$data)$graph
##提取igraph对象中的数据
# igraph_dt_lst=toVisNetworkData(igraph_obj, idToLabel = F)
###为了可视化效果与ggraph的效果近似，需要做一些数据修改
dt_lst=ggplot_build(ggraph_obj)$data
g_node_dt=dt_lst[[3]]
g_edge_dt=dt_lst[[1]]

igraph_obj <-igraph_obj %>%
  set_vertex_attr("color", value = g_node_dt$colour)%>%
  set_vertex_attr("size", value = scales::rescale(x = g_node_dt$size,to = c(10,40)))%>%
  set_vertex_attr("shape", value = "dot")%>% ###shape强制转化为dot
  set_edge_attr("width", value = g_edge_dt%>%
                  distinct(.,from,to,.keep_all = T)%>%
                  .$edge_width%>%
                  scales::rescale(x = .,to = c(1,5)))
# igraph_obj=delete_vertex_attr(igraph_obj, "shape")

# vertex_attr_names(igraph_obj)

###为了保证visNetwork的layout和ggraph的一致，这里将ggraph的layout复制过来直接用
###但是需要注意的是：visNetwork原点(即：(0,0))的坐标是左上角，所以复制过来的layout需要进行Y轴翻转
coords=data.frame(x=g_node_dt$x,y=-g_node_dt$y)%>%as.matrix()

net=visIgraph(igraph_obj, idToLabel = T, type = "full") %>%
      visIgraphLayout(layout = "layout.norm",
                      layoutMatrix = coords,
                      type = "full")  %>%
  visOptions(highlightNearest = list(enabled = T, hover = F,
                                     degree = 1,
                                     hideColor = "rgba(0,0,0,0.05)",
                                     labelOnly = FALSE),
             nodesIdSelection = T,
             autoResize = T) %>%
  visPhysics(stabilization = F,solver = "barnesHut")%>%
  visNodes(
    font = list(size = 40, multi = "html"),
    # color = list(background = "white", border = NA)
  ) %>%
  visEdges(dashes = F,
           color=list(
             color=scales::alpha(c("grey25"),0.3),
             highlight = "red", hover = "blue")  ###Hover and Highlight parameters does work! 
  )%>%
  visInteraction(hover = T)

##cite : https://stackoverflow.com/questions/70497768/how-to-go-from-a-ggraph-object-to-an-igraph-object-r

ggraph-visNetwork的动态可视化方案有如下一些不足，用时需注意：

虽然可以指从ggraph对象中提取到对应的nodes和edges的数据，以及对应的属性数据(ndes：id/color/label/shape/size等，edges:from/to/value/color等)，但是在visNetwork函数中直接用这些属性值进行绘图发现效果与预期根本不一样，所以需要自己修改一下以达预期
其中点的color数据是可以直接转移过来用的，点的形状可能不一定可以使用，visNetwork不支持映射或者ggplot2的数值shape映射，它支持shape的名称，详见：nodeStyles，如需对应时，可以先看看两个体系支持的shape分别有哪些，进行转换即可；
其中边的宽度和颜色可能也需要调整适配，主要是透明度和缩放问题
第一个方案数据获取自ggplot图层中的相关slot，这个获取方案不稳健，可能不同的ggplot2版本，存储的slot也不同；其次第一个方案绘图结果中，当选择点和临近点时，高亮问题是无效的，主要是在nodes的矩阵中，有color这一列就会导致高亮无效，这个是visNetwork的bug，自己提供了一个解决办法；此外，第一个方案的图像的高度和宽度不好设置，往往结果达不到预期；综合来看，第二种方案较为可靠，第一种方案的不足均可避开；
visNetwork的图例很难控制，尤其是对连续性配色的图例目前没有好的办法进行复现;
visNetwork的layout的起始坐标(0,0)是在左上角，需要将ggraph的layout坐标进行Y轴翻转，否则visNetwork的可视化结果与ggraph结是Y轴对称；
更多的visNetwork使用教程详见：visNetwork可视化教程。

其他方案(伪动态)¶

所谓的伪动态就是没有像visNetwork或者一样networkD3可以任意拖拽边或者节点，他只会交互式的显示点的信息和边的信息。

ggnetwork方案

相比于visNetwork，该包在颜色配置和点的形状大小上会很好的继承ggraph对象中的数据，也可以指做到跟多的自定义，但是其转化为动态的plotly对象后，他的动态可视化上却不如visNetwork，究其原因可能是plotly.js可能不支持，当然也可能是自己没设置正确，如果把plotly与Shiny一起用的话，虽然可以进行更好的动态展示效果，但是也远不如visNetwork或者networkD3等包。

S

  library(network)
  library(ggnetwork)
  library(igraph)
  library(ggraph)
  library(ggplot2)
  library(dplyr)
  ###提取数据
  igraph_obj=attributes(ggraph_obj$data)$graph

  ###该方案报错，可能是ggnetwork和igraph的版本不兼容
  # ig=as.igraph(igraph_obj)
  # n1 = ggnetwork(ig, layout = "fruchtermanreingold", cell.jitter = 0.75)

  ###转化为邻接矩阵
  n = network(as.matrix(as_adjacency_matrix(igraph_obj)), directed = FALSE)
  n1 = ggnetwork(n, layout = "kamadakawai", cell.jitter = 0.75)%>%unique(.)

  vertex_attr_dt1=as_long_data_frame(igraph_obj)[,c("from_name","from_color","from_shape","from_degree","from_size")]%>%
    unique()
  vertex_attr_dt2=as_long_data_frame(igraph_obj)[,c("to_name","to_color","to_shape","to_degree","to_size")]%>%
    unique()
  colnames(vertex_attr_dt2)=colnames(vertex_attr_dt1)
  vertex_attr_dt=rbind(vertex_attr_dt1,vertex_attr_dt2)%>%unique(.)
  colnames(vertex_attr_dt)=c("name","color","shape","degree","size")

  n1=left_join(n1,vertex_attr_dt,by = c("vertex.names"="name"))

  ##绘图
  gg=ggplot(n1, aes(
    x = x,
    y = y,
    xend = xend,
    yend = yend,label=`vertex.names`
  )) +
    geom_edges(color = "grey50",linetype="dashed",curvature = 0.0) +
    geom_nodes(aes(color = color,size=size)) +
    scale_color_gradientn(name="xx",colours = c("blue","orange","red"),
                          breaks=ceiling(seq(min(n1$color,na.rm = T),max(n1$color,na.rm = T),
                                             (max(n1$color,na.rm = T)-min(n1$color,na.rm = T))/4)),
                          guide = guide_colorbar(order = 3))+
    geom_nodetext(aes(label = vertex.names), size = 2,fontface = "bold")+
    theme_blank();gg

  plotly::ggplotly(gg)%>%
    # config(edits = list(shapePosition = TRUE))
  # config(modeBarButtonsToRemove = c("zoomIn2d", "zoomOut2d"))
    # layout(xaxis = list(fixedrange = TRUE), yaxis = list(fixedrange = TRUE))
    # layout(
    #   shapes=list(
    #     # type = "line",  line = list(color = "red"),
    #     x0 = 0,  x1 = 1, xref="paper",
    #     y0 = 0, y1 = 0
    #   )
    # ) %>%
    config(editable=TRUE)

  plotly::ggplotly(gg)%>% 
    plotly::layout(
      dragmode = "drawopenpath")

  library(htmlwidgets)
  ggplotly(gg, dynamicTicks = TRUE) %>%
    rangeslider() %>%
    layout(hovermode = "x")%>%
    saveWidget('a.html')

geomnet方案

该包支持ggplot2绘制网络图，也支持plotly的动态展示，但是目前官方给的测试示例都没跑成功(可能是自己的环境问题)，等后续测试成功了再进行补充