提高嵌套 for 循环速度 R 创建邻接矩阵

Posted 2023-02-19

【中文标题】提高嵌套 for 循环速度 R 创建邻接矩阵

【英文标题】：Improve nested for loop speed R creating adjacency matrix

【发布时间】：2020-07-20 12:30:50

【问题描述】：

我想创建一个邻接矩阵。该矩阵应该显示每个关键字有多少相同的值字符串。

我目前使用两个 for 循环的方法在处理更多数据时需要一段时间。我已经研究了 foreach 包，但无法理解这个例子。感谢您对任何速度提升的帮助；）

#create reproducible dataset
set.seed(11)
x <- rep('keyword', 10)
y <- seq(1, 10)
z <- rep('value', 10)

df <- tibble::tibble(Keyword = rep(paste0(x,y),4), 
                     Values = paste0(sample(z, 40, replace = TRUE), 
                                     sample(y, 40, replace = TRUE)))

#format dataset
temp_df <- df %>% 
  dplyr::group_by(Keyword) %>%
  dplyr::summarise(Values = toString(Values))  %>%
  dplyr::ungroup() %>%
  dplyr::distinct(Keyword, .keep_all = TRUE)

#initialise adjacency matrix
adj_matrix <- data.frame()

#for loops to iterate through values
for (i in 1:nrow(temp_df)) 

  y <- trimws(unlist(strsplit(temp_df$Values[i], split = ',')))

  for (g in i:nrow(temp_df)) 

    f <- trimws(unlist(strsplit(temp_df$Values[0+g], split = ',')))
    z <- y %in% f
    adj_matrix[i,g] <- sum(z)

  


#name rows and columns
colnames(adj_matrix) <- temp_df$Keyword
rownames(adj_matrix) <- temp_df$Keyword

adj_matrix 是稀疏的（即只有一半被填充），您可以看到哪个关键字共享多少相同的值字符串。有了这个矩阵，我可以很容易地在网络图中显示关系。

提前致谢！

一月

【问题讨论】：

快速分析表明trimws 部分占用了大部分时间。目前你运行这个函数几乎 0.5*nrow^2 次。考虑在您的两个循环之前进行修剪以将其减少到 nrow 次。

你和lineprof一起工作？从未尝试过，但会尝试更好地了解我的功能。

【参考方案1】：

我不清楚您的真实数据是以df 还是temp_df 开头的。无论哪种方式，您都可以通过使用 outer() 来避免嵌套循环中的处理，这应该会加快速度。

library(dplyr)
library(purrr)

am_outer <- df %>%
  split(f = .$Keyword) %>%
  map(pull, Values) %>%
  outer(., ., function(x,y) sapply(seq_along(x), function(i) sum(x[[i]] %in% y[[i]])))

am_outer[lower.tri(am_outer)] <- NA

identical(data.frame(am_outer), adj_matrix)

[1] TRUE

如果数据以temp_df 开头，您可以使用：

temp_df %>% 
  separate_rows(Values, sep = ", ") %>% 
  split(f = .$Keyword) %>%
  map(pull, Values) %>%
  outer(., ., function(x,y) sapply(seq_along(x), function(i) sum(x[[i]] %in% y[[i]])))

【讨论】：

或作为 2-liner：v <- split(df$Values, df$Keyword) ; outer(v, v, FUN = mapply, FU = function(x, y) sum(x %in% y))