Параллельный foreach работает на величины медленнее, чем одноядерный sapply с командами igraph

Question

для очень большого сетевого набора данных я хотел бы суммировать атрибуты (количество рабочих мест) соседних вершин (фирм) для каждой вершины в сети. У меня есть функциональный код для этого, используя функцию «sapply». Поскольку этот код работает медленно, я хотел бы использовать распараллеливание с циклом "foreach". Этот код работает нормально при использовании небольшой сети. Однако при масштабировании сетевых данных цикл foreach работает бесконечно.

Ниже я привел пример с игрушкой. Код генерирует небольшую сеть с 500 вершинами. Увеличивая количество вершин, вы увидите, что распараллеливание не уменьшает время, необходимое для выполнения кода, а наоборот. Вам придется изменить рабочий каталог и путь к библиотеке, но кроме этого должен выполняться код.

У кого-нибудь есть идея, почему это происходит, и потенциально есть решение для ускорения кода? Буду признателен за любую оказанную помощь. Спасибо!

Себастьян

rm(list = ls()) 

#############################
## Load or install libraries

  ipak <- function(pkg){

    new.pkg <- pkg[!(pkg %in% installed.packages()[, "Package"])]

    if (length(new.pkg)) 

      install.packages(new.pkg, dependencies = TRUE)

    sapply(pkg, require, character.only = TRUE)

  }

  packages <- c("parallel","foreach","doParallel", "igraph", "intergraph", "dplyr")

  ipak(packages)

# Set working directory

  setwd("N:/Ablagen/D01700-IAB-Projekte/D01700-Baehr_Reichelt_Networks/mwe_network/res/")



set.seed(123)

# Simulate network data

  g <- barabasi.game(500)

# Simulate the number of jobs at each vertice (firm)

  V(g)$jobs <- round(runif(vcount(g),1,200),0)
  V(g)$jobs


  # start time measurement

    ptm <- proc.time()

  # prepare data frame to collect results

    nodes_export <- as.data.frame(1:gorder(g))  

# Initiate parallelization

  # Set number of clusters and cores
  cl<-makeCluster(2)
  registerDoParallel(cl, cores = 6)

  # set path to where you have installed the r packages

    clusterEvalQ(cl, .libPaths("N:/Ablagen/D01700-IAB-Projekte/D01700-Baehrs007/Projekte/R/win-library/3.5")) 

  # an examplatory loop should run for two years

      yearlist <- c(1998,1999) 


  # initiate results list

    results <- vector("list", length(yearlist) )

  # run loop twice

    for(yr in seq_along(yearlist)) {  ## year loop

      print(yearlist[yr])
      nodes_export$year <- yearlist[yr] 

      # calculate the number of adjacent jobs using apply (without parallelisation)

        # V(g)$jobsum = sapply( ego(g,1,V(g),mode = 'all',mindist = 1), function(v) sum(V(g)[v]$jobs) )
        # nodes_export$jobsum <- V(g)$jobsum
        # tic("Without parallelization") 

      # calculate the number of adjacent jobs using foreach (with parallelisation)

        V(g)$jobsum <- foreach(v=1:gorder(g) , .packages=c("igraph", "doParallel"), .combine = c)  %dopar%
          sum(ego(g,1,V(g),mode = 'all',mindist = 1)[[v]]$jobs)
          tic("With parallelization")

      # write results into result list

        results[[yr]] <- nodes_export

    } ## year loop,

  stopCluster(cl)

  # combine the two result lists into a data frame for export

    export <- bind_rows(results) 

  # stop time measurement  

    vec_time <- toc()