使用 tidygraph 在 igraph 中自动循环

Question

您好，希望一切顺利。 我对我之前的问题进行了编辑，希望它更清楚。

我创建了一个igraph 对象，并希望多次运行相同的分析并在每次迭代中提取一些信息。

我不能分享全部数据，所以我只分享一小部分。 df_edge如下：

library(dplyr)
job_1 <-c(1,2,6,6,5,6,7,8,6,8,8,6,6,8)
job_2 <- c(2,4,5,8,3,1,4,6,1,7,3,2,4,5)
weight <- c(1,1,1,2,1,1,2,1,1,1,2,1,1,1)

df_edge <- tibble(job_1,job_2,weight)
df_edge %>% glimpse()

Rows: 14
Columns: 3
$ job_1  <dbl> 1, 2, 6, 6, 5, 6, 7, 8, 6, 8, 8, 6, 6, 8
$ job_2  <dbl> 2, 4, 5, 8, 3, 1, 4, 6, 1, 7, 3, 2, 4, 5
$ weight <dbl> 1, 1, 1, 2, 1, 1, 2, 1, 1, 1, 2, 1, 1, 1

df_node如下：

job_id <- c(1,2,3,4,5,6,7,8)
job_type <- c(1,2,0,0,3,1,1,1)

df_node <- tibble(job_id,job_type)
df_node %>% glimpse()

Rows: 8
Columns: 2
$ job_id   <dbl> 1, 2, 3, 4, 5, 6, 7, 8
$ job_type <dbl> 1, 2, 0, 0, 3, 1, 1, 1

创建igraph 对象：

library(igraph)
library(tidygraph)

tp_network_subset <- graph.data.frame(df_edge,vertices = df_node,directed = F)

df_node 中job_type 列的摘要

    df_node %>%
     count(job_type)
   
A tibble: 4 x 2
  job_type     n
     <dbl> <int>
1        0     2
2        1     4
3        2     1
4        3     1

我手动执行的操作如下：

### finding a job_id that belongs to job_type==1 category

    df_node %>% filter(job_type==1) %>%
    select(job_id) 

 A tibble: 4 x 1
  job_id
   <dbl>
1      1
2      6
3      7
4      8
# for instance, I picked one of them and it is job_id = 6

### using the job_id to create a subgraph by selecting order 1 neighbors of this job_id (6)

node_test <- make_ego_graph(tp_network_subset,order = 1 ,nodes="6")

### creating a dataframe of this subgrapgh where there is no isolated nodes

df_test <- as_tbl_graph(node_test[[1]]) %>% 
    activate(nodes) %>%
    filter(!node_is_isolated()) %>% 
    as_tibble()

df_test %>% glimpse()
Rows: 6
Columns: 2
$ name     <chr> "1", "2", "4", "5", "6", "8"
$ job_type <dbl> 1, 2, 0, 3, 1, 1

## subgraph size is 6 which will be an outcome of interest
### if the graph is zero length , I should stop here and pick another job_id that belongs to job_type==1 category

在这个例子中，not zero length 中的图表所以我继续到next step

 ### calculating the measure of interest in respect to job_type==1 category
 
   df_test %>% 
    summarise(job_rate= (nrow(df_test %>% filter(job_type==1)))/(nrow(df_test %>% 
    filter(job_type %in% c(1,2,3)))))
# 0.6

如果 job_rate > 0.5 ，我想保留子图的 job_type=4 类别的 job_rate 和行（对应节点）。在这种情况下，job_rate was 0.6 所以我保留以下内容

 df_final <- as_tbl_graph(node_test[[1]]) %>% 
        activate(nodes) %>%
        filter(!node_is_isolated()) %>% 
        as_tibble() %>% filter(job_type==0)

# A tibble: 1 x 2
   name  job_type
    <chr>    <dbl>
1    4            0

但是，我需要分配它们对应的job__rate 和一些other related columns。所以，我最喜欢的结果是

    name  job_type    subgraph_origin_id      job_rate  subgraph_size  no_(job_type==0)_in_subgrapgh    no_(job_type==1)_in_subgrapgh   no_(job_type==2)_in_subgrapgh   no_(job_type==3)_in_subgrapgh                                                           
    <chr>    <dbl>
1    4         0             6                  0.6         6

所以，我需要执行此过程并为所有 job_type==1 节点创建子图。如果图表不是zero length 及其job_rate > 0.5，则提取该子图表 中的所有对应节点，以及最喜欢结果中显示的job_rate 和其他列.

Answer 1

这对你有用吗？

dflst <- split(df_node, job_type)
tpe <- as.numeric(names(dflst))
out <- tibble()
for (i in seq_along(dflst)) {
  df <- dflst[[i]]
  node_test_lst <- make_ego_graph(tp_network_subset, order = 1, nodes = df$job_id)
  origin_id <- df$job_id
  jtpe <- tpe[i]
  for (j in seq_along(node_test_lst)) {
    node_test <- node_test_lst[[j]]
    df_test <- as_tbl_graph(node_test) %>%
      activate(nodes) %>%
      filter(!node_is_isolated()) %>%
      as_tibble()
    if (nrow(df_test %>% filter(job_type == 0)) > 0 & any(df_test$job_type %in% 1:3)) {
      job_rate <- with(df_test, sum(job_type == jtpe) / sum(job_type %in% 1:3))
      if (job_rate > 0.5) {
        df_final <- df_test %>%
          filter(job_type == 0) %>%
          mutate(
            subgraph_origin_id = origin_id[j],
            job_rate = job_rate,
            subgraph_size = nrow(df_test)
          ) %>%
          cbind(
            setNames(
              as.list(table(factor(df_test$job_type, levels = 0:3))),
              sprintf("no_(job_type==%s)_in_subgrapgh", 0:3)
            )
          )
        out <- out %>% rbind(df_final)
      }
    }
  }
}

给了

> out
  name job_type subgraph_origin_id job_rate subgraph_size
1    4        0                  6     0.60             6
2    4        0                  7     1.00             3
3    3        0                  8     0.75             5
  no_(job_type==0)_in_subgrapgh no_(job_type==1)_in_subgrapgh
1                             1                             3
2                             1                             2
3                             1                             3
  no_(job_type==2)_in_subgrapgh no_(job_type==3)_in_subgrapgh
1                             1                             1
2                             0                             0
3                             0                             1