Улучшение вложенности для l oop speed R, создание матрицы смежности - PullRequest
Новая
       84

Улучшение вложенности для l oop speed R, создание матрицы смежности

1 голос
/ 08 апреля 2020

Я хочу создать матрицу смежности. Матрица должна показывать, сколько одинаковых Value-строк на ключевое слово.

Мой текущий подход с двумя циклами 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 является разреженным (т. Е. Заполнена только половина), и вы можете видеть, какое ключевое слово имеет общее количество идентичных строк-значений. С помощью этой матрицы я могу легко отобразить отношения на диаграмме сети.

Заранее спасибо!

Ян

1 Ответ

1 голос
/ 08 апреля 2020

Мне не ясно, начинаются ли ваши реальные данные как df или temp_df. В любом случае вы можете избежать обработки во вложенном l oop, используя 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]])))
...