使用tidygraph实现igraph中的回路自动化_R_Loops_Dplyr_Igraph

使用tidygraph实现igraph中的回路自动化

r loops

使用tidygraph实现igraph中的回路自动化,r,loops,dplyr,igraph,R,Loops,Dplyr,Igraph,你好，希望一切顺利。我对上一个问题进行了修改，希望它能让问题更清楚我创建了一个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,

你好，希望一切顺利。我对上一个问题进行了修改，希望它能让问题更清楚

我创建了一个

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

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)

我正在手动执行以下操作：

### 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

如果

job_rate>0.5

，我希望保留子图的

job_rate

和

job_type=4

类别的行（对应节点）。在本例中，

作业率为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\u type==1

节点创建子图。如果图形长度不为零且其

作业率>0.5

，则提取子图形中的所有对应节点，以及
作业率
和收藏夹结果中显示的其他列。
这对您有用吗

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) } } } }

@菲尔，谢谢你的编辑。你有什么办法帮忙吗？非常感谢！如果您能创建一个最小的可复制示例（示例数据），我可以尝试帮助您。@Brigadeiro，谢谢您的反馈。我只是提供了一些数据，希望能有所帮助。非常感谢！请（1）加载运行代码所需的软件包，（2）在说明手动解决问题的方法之前，请清楚说明您试图解决的问题。@ThomaslsCoding，感谢您提供答案。因此，我在list2DF（as.list（表（factor（df\u test$job\u type，levels=0:3））中得到了
错误：找不到函数“list2DF”
。我已经安装了
library（base）
和
library（base）
，但仍然收到相同的错误。@Alex对不起，我的错。现在我已经修好了。请重试。@Alex您是在您的帖子中的数据上尝试了我的代码还是我们的真实数据？我没有看到你的帖子数据有任何错误。@Alex不用担心。我认为这取决于你如何定义你的
job\u rate
。从您的代码来看，似乎是
作业类型=0
与
作业类型=1,2或3的比率。在这种情况下，如果有许多行的值0 ，但1、2或3的值很少，那么肯定会给出大于1 的速率。我不认为这是一个编码问题。它由您如何定义job\u rate @Alex决定，您应该使用node\u test\lst 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 ### 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 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 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 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