R语言如果计算需要从另一个数据框中提取数据，如何对数据框的每一行使用apply/lapply

xyhw6mcr 于 2023-03-10 发布在其他

关注(0)|答案(1)|浏览(198)

我试图计算一个双模网络数据的雅卡系数。
我的数据如下所示：

df <- data.frame(patent = c("A", "B", "B", "C", "C", "C"),
                 class = c("X", "Y", "Z", "X", "Y", "Z"))

node_list <- 
  df %>% 
  select(class) %>% distinct(class)

edge_list <- as.data.frame(t(combn(node_list,2)))
edge_list$no_patents_V1 <- NA
edge_list$no_patents_V2 <- NA
edge_list$no_patents_V1_V2 <- NA
edge_list$no_patents_V1_nV2 <- NA

我需要计算边权重。我的边权重是：我需要找出有多少专利属于1类和2类，1类但不是2类，2类但不是1类，然后我计算jaccard系数为a/a+b+c。
我还需要多少专利属于每个独特的类别总数。
我尝试了以下代码：

`for(k in 1:nrow(edge_list)){
      
      edge_list[k,"no_patents_V1"] <-
        df%>% 
        filter(str_detect(classes, edge_list[k,1])) %>%
        nrow()
      
      edge_list[k,"no_patents_V2"] <-
        df%>% 
        filter(str_detect(classes, edge_list[k,2])) %>%
        nrow()
      
      edge_list[k,"no_patents_V1_V2"] <-
        df%>% 
        filter(str_detect(classes, edge_list[k,1])) %>%
        filter(str_detect(classes, edge_list[k,2])) %>%
        nrow()
      
      edge_list[k,"no_patents_V1_nV2"] <-
        df%>% 
        filter(str_detect(classes, edge_list[k,1])) %>%
        filter(!str_detect(classes, edge_list[k,2])) %>%
        nrow()
      
      edge_list[k,"no_patents_V2_nV1"] <-
        df%>% 
        filter(str_detect(classes, edge_list[k,2])) %>%
        filter(!str_detect(classes, edge_list[k,1])) %>%
        nrow()
    }
`

我总共有30个类，因此在边列表中有435行。这是超级低效的。你能建议一些有效的方法来解决这个问题吗？
我总共有大约一百万项专利。

r

来源：https://stackoverflow.com/questions/75597998/how-can-i-use-apply-lapply-on-each-row-of-a-data-frame-where-calculation-require

1条答案

按热度按时间

qlzsbp2j1#

这可能是你正在寻找的，在基础R中完成。创建数据：

df <- data.frame(patent = c("A", "B", "B", "C", "C", "C"),
                 class = c("X", "Y", "Z", "X", "Y", "Z"))

node_list <- unique(df$class)
edge_list <- as.data.frame(t(combn(node_list, 2)))

请注意，原始代码在创建边列表时返回错误。循环edge_list中的每一行：

for(i in 1:nrow(edge_list)) {
  V1 <- df[df$class == edge_list[i,]$V1,]$patent
  V2 <- df[df$class == edge_list[i,]$V2,]$patent
  edge_list$V1_and_V2[i] <- length(intersect(V1, V2))
  edge_list$V1_not_V2[i] <- length(setdiff(V1, V2))
  edge_list$V2_not_V1[i] <- length(setdiff(V2, V1))
}

我们使用intersect和setdiff的集合比较来简化任务，不需要寻找字符串。我通常不喜欢for循环，但在这种情况下应该足够了。如果没有，你可以把它放到sapply调用中。输出：

edge_list
V1 V2 V1_and_V2 V1_not_V2 V2_not_V1
X  Y         1         1         1
X  Z         1         1         1
Y  Z         2         0         0

Add-on：对于真正大的数据集，我们可以使用future.apply并行化，并将代码封装在future_sapply调用中。给定一个包含500万行和435个两个类的唯一组合的大型data.frame：

df <- data.frame(patent = sample(1:1000, 5000000, replace = TRUE),
                 class = sample(1:30, 5000000, replace = TRUE))
node_list <- unique(df$class)
edge_list <- as.data.frame(t(combn(node_list, 2)))

使用future_sapply：

library(future.apply)
plan(multisession, workers = 10)
proc <- future_sapply(1:nrow(edge_list), function(x) {
  V1 <- df[df$class == edge_list$V1[x],]$patent
  V2 <- df[df$class == edge_list$V2[x],]$patent
  V1_and_V2 <- length(intersect(V1, V2))
  V1_not_V2 <- length(setdiff(V1, V2))
  V2_not_V1 <- length(setdiff(V2, V1))
  return(c(V1_and_V2, V1_not_V2, V2_not_V1))
}, future.seed = TRUE)
edge_list <- cbind(edge_list, t(proc))
names(edge_list)[3:5] <- c("V1_and_V2", "V1_not_V2", "V2_not_V1")

微基准测试：

Unit: seconds
          expr       min        lq      mean    median        uq       max neval cld
      for_loop 19.003180 20.485825 20.582161 20.734163 20.943270 21.081319    10   b
 future_sapply  4.116312  4.216228  4.259608  4.265985  4.327765  4.368124    10  a

赞(0）回复(0）举报 2023-03-10

我来回答

R语言如果计算需要从另一个数据框中提取数据，如何对数据框的每一行使用apply/lapply

1条答案

相关问题

热门标签

最新问答

R语言 如果计算需要从另一个数据框中提取数据，如何对数据框的每一行使用apply/lapply

1条答案

相关问题

热门标签

最新问答

R语言如果计算需要从另一个数据框中提取数据，如何对数据框的每一行使用apply/lapply