为visNetwork创建节点和边表

时间:2018-03-01 23:59:43

标签: r functional-programming visnetwork

如何使这更通用,可以应用于更多或更少列的数据表?更具功能性,重复代码更少。

我喜欢链接功能的管道代码。 我到目前为止:

    df1 <- df1 %>% unique %>% apply(MARGIN = 2,FUN = function(x)return(cumsum(!duplicated(x)))) %>% 
  `colnames<-`(paste0("id",1:ncol(.))) %>% cbind(df1,.)

然而,我正努力将下一个表达链接起来:

df1 <- df1 %>% mutate(id2=(id2+max(id1)),
                      id3=(id3+max(id2)),
                      id4=(id4+max(id3)))

这是原始代码。

df1 <- structure(list(step1 = c("ab1", "ab1", "ab1", "ab1", "ab1", "ab1", 
                                "ab1", "ab1", "ab1", "ab1", "ab1", "ab1", "ab1", "ab34", "ab34", 
                                "ab34", "ab34", "ab34", "ab34", "ab34", "ab34", "ab34", "ab34", 
                                "ab34"), step2 = c(5000546L, 5000546L, 5000613L, 5000613L, 5000623L, 
                                                   5000623L, 5000627L, 5000627L, 5000645L, 5000645L, 5000684L, 5000684L, 
                                                   5000694L, 5000694L, 5000698L, 5000698L, 5000716L, 5000716L, 5000416L, 
                                                   5000416L, 5000611L, 5000611L, 5000157L, 5000157L), step3 = c("500010H10A", 
                                                                                                                "500010H10B", "500010H11A", "500010H11B", "500010H12A", "500010H12B", 
                                                                                                                "500010H13A", "500010H13B", "500010H14A", "500010H14B", "500010H15A", 
                                                                                                                "500010H15B", "500010H16A", "500010H16B", "500010H17A", "500010H17B", 
                                                                                                                "500010H18A", "500010H18B", "500010H19A", "500010H19B", "500010H20A", 
                                                                                                                "500010H20B", "500010H21A", "500010H21B"), step4 = c(NA, NA, 
                                                                                                                                                                     NA, "50133B000", "50133B000", "50133B000", NA, "50138B000", "50138B000", 
                                                                                                                                                                     "50138B000", "50138B000", NA, "50138B000", "50138B000", "50138B000", 
                                                                                                                                                                     NA, "50224B000", "50224B000", NA, "50224B000", NA, "50224B000", 
                                                                                                                                                                     "50011B000", "50011B001")), .Names = c("step1", "step2", "step3", 
                                                                                                                                                                                                            "step4"), class = "data.frame", row.names = c(NA, -24L))
#
if (!require(dplyr)) install.packages('dplyr')
if (!require(visNetwork)) install.packages('visNetwork')
if (!require(stringr)) install.packages('stringr')
library(dplyr)
library(visNetwork)
library(stringr)
df1$id <- cumsum(!duplicated(df1$step1))
df1$id2 <- cumsum(!duplicated(df1$step2))
df1$id3 <- cumsum(!duplicated(df1$step3))
df1$id4 <- cumsum(!duplicated(df1$step4))
df1 <- df1 %>% mutate(id2=(id2+max(id)),
                      id3=(id3+max(id2)),
                      id4=(id4+max(id3)))
nodes <- data.frame(label=c(df1$step1,df1$step2,df1$step3,df1$step4) %>% str_wrap(10),
                    id=c(df1$id,df1$id2,df1$id3,df1$id4),
                    color=c(rep("red",24),rep("orange",24),rep("purple",24),rep("lightblue",24)),
                    level=c(rep(1,24),rep(2,24),rep(3,24),rep(4,24))) %>% 
  unique %>% filter(!is.na(label))
edges <- data.frame(from=c(df1$id,df1$id2,df1$id3),to=c(df1$id2,df1$id3,df1$id4)) %>% unique

visNetwork(nodes,edges,height=700, width="100%") %>% 
  visOptions(highlightNearest = TRUE,
             collapse = TRUE)  %>% visHierarchicalLayout(nodeSpacing = 300) %>% visPhysics(hierarchicalRepulsion = list(nodeDistance=135))

1 个答案:

答案 0 :(得分:1)

我对你的目标感到有些困惑,但这是我从Jesse Sadler博客(https://www.jessesadler.com/post/network-analysis-with-r/)采用的基本工作流程。这是一个基于我为引文分析制作的网络图的示例,但是当我想制作网络图时,它也应用于各种其他实例。数据集已经简化,因此并非所有这些步骤都是真正必要的,但这是我在正常情况下会做的事情。

library(tidyverse)
library(visNetwork)

data <- tibble(citation = c(1:5), article = c(1:5), weight = c(1, 3, 4, 3, 6))

sources <- data %>%
    distinct (citation) %>%
    rename(label = citation)

destinations <- data %>%   
    distinct (article) %>%
    rename(label = article)

nodes <- full_join(sources, destinations, by = "label") %>%
    rowid_to_column("id")

edges <- data %>%
   group_by(citation, article) %>%
   summarize(weight = n()) %>%
   ungroup() %>%
   left_join(nodes, by = c("citation" = "label")) %>%
   rename(from = id) %>%
   left_join(nodes, by = c("article" = "label")) %>%
   rename(to = id) %>%
   select(edges, from, to, weight)

visNetwork(nodes, edges)