为什么每个额外节点的foreach％dopar％会变慢？

时间：2017-01-29 20:40:34

标签： r multithreading foreach parallel-processing doparallel

我写了一个简单的矩阵乘法来测试我的网络的多线程/并行化功能，我注意到计算速度比预期慢得多。

测试很简单：乘以2个矩阵（4096x4096）并返回计算时间。矩阵和结果都没有存储。计算时间并不简单（50-90秒，具体取决于您的处理器）。

条件：我使用1个处理器重复此计算10次，将这10个计算分成2个处理器（每个5个），然后是3个处理器，......最多10个处理器（1个计算到每个处理器）。我预计总计算时间会逐步减少，我预计10个处理器完成计算 10次的速度与一个处理器执行相同的操作一样快。

结果：取而代之的是，计算时间减少了2倍，是 SLOWER 的5倍。

enter image description here

当我计算每个节点的平均计算时间时，我希望每个处理器在相同的时间内（平均）计算测试，而不管分配的处理器数量。我惊讶地发现仅仅向多处理器发送相同的操作会减慢每个处理器的平均计算时间。

enter image description here

任何人都可以解释为什么会这样吗？

请注意，问题是不这些问题的重复：

foreach %dopar% slower than for loop

或

Why is the parallel package slower than just using apply?

因为测试计算不是微不足道的（即50-90秒而不是1-2秒），并且因为我可以看到处理器之间没有通信（即除了计算时间之外没有返回或存储结果）。

我已附加脚本和函数以供复制。

library(foreach); library(doParallel);library(data.table)
# functions adapted from
# http://www.bios.unc.edu/research/genomic_software/Matrix_eQTL/BLAS_Testing.html

Matrix.Multiplier <- function(Dimensions=2^12){
  # Creates a matrix of dim=Dimensions and runs multiplication
  #Dimensions=2^12
  m1 <- Dimensions; m2 <- Dimensions; n <- Dimensions;
  z1 <- runif(m1*n); dim(z1) = c(m1,n)
  z2 <- runif(m2*n); dim(z2) = c(m2,n)
  a <- proc.time()[3]
  z3 <- z1 %*% t(z2)
  b <- proc.time()[3]
  c <- b-a
  names(c) <- NULL
  rm(z1,z2,z3,m1,m2,n,a,b);gc()
  return(c)
}

Nodes <- 10
Results <- NULL
for(i in 1:Nodes){
  cl <- makeCluster(i)
  registerDoParallel(cl)
  ptm <- proc.time()[3]
  i.Node.times <- foreach(z=1:Nodes,.combine="c",.multicombine=TRUE, 
                          .inorder=FALSE) %dopar% {
                            t <- Matrix.Multiplier(Dimensions=2^12)
                          }
  etm <- proc.time()[3]
  i.TotalTime <- etm-ptm
  i.Times <- cbind(Operations=Nodes,Node.No=i,Avr.Node.Time=mean(i.Node.times),
                   sd.Node.Time=sd(i.Node.times),
                   Total.Time=i.TotalTime)
  Results <- rbind(Results,i.Times)
  rm(ptm,etm,i.Node.times,i.TotalTime,i.Times)
  stopCluster(cl)
}
library(data.table)
Results <- data.table(Results)
Results[,lower:=Avr.Node.Time-1.96*sd.Node.Time]
Results[,upper:=Avr.Node.Time+1.96*sd.Node.Time]
Exp.Total <- c(Results[Node.No==1][,Avr.Node.Time]*10,
               Results[Node.No==1][,Avr.Node.Time]*5,
               Results[Node.No==1][,Avr.Node.Time]*4,
               Results[Node.No==1][,Avr.Node.Time]*3,
               Results[Node.No==1][,Avr.Node.Time]*2,
               Results[Node.No==1][,Avr.Node.Time]*2,
               Results[Node.No==1][,Avr.Node.Time]*2,
               Results[Node.No==1][,Avr.Node.Time]*2,
               Results[Node.No==1][,Avr.Node.Time]*2,
               Results[Node.No==1][,Avr.Node.Time]*1)
Results[,Exp.Total.Time:=Exp.Total]

jpeg("Multithread_Test_TotalTime_Results.jpeg")
par(oma=c(0,0,0,0)) # set outer margin to zero
par(mar=c(3.5,3.5,2.5,1.5)) # number of lines per margin (bottom,left,top,right)
plot(x=Results[,Node.No],y=Results[,Total.Time],  type="o", xlab="", ylab="",ylim=c(80,900),
     col="blue",xaxt="n", yaxt="n", bty="l")
title(main="Time to Complete 10 Multiplications", line=0,cex.lab=3)
title(xlab="Nodes",line=2,cex.lab=1.2,
      ylab="Total Computation Time (secs)")
axis(2, at=seq(80, 900, by=100), tick=TRUE, labels=FALSE)
axis(2, at=seq(80, 900, by=100), tick=FALSE, labels=TRUE, line=-0.5)
axis(1, at=Results[,Node.No], tick=TRUE, labels=FALSE)
axis(1, at=Results[,Node.No], tick=FALSE, labels=TRUE, line=-0.5)
lines(x=Results[,Node.No],y=Results[,Exp.Total.Time], type="o",col="red")
legend('topright','groups',
       legend=c("Measured", "Expected"), bty="n",lty=c(1,1),
       col=c("blue","red"))
dev.off()

jpeg("Multithread_Test_PerNode_Results.jpeg")
par(oma=c(0,0,0,0)) # set outer margin to zero
par(mar=c(3.5,3.5,2.5,1.5)) # number of lines per margin (bottom,left,top,right)
plot(x=Results[,Node.No],y=Results[,Avr.Node.Time],  type="o", xlab="", ylab="",
     ylim=c(50,500),col="blue",xaxt="n", yaxt="n", bty="l")
title(main="Per Node Multiplication Time", line=0,cex.lab=3)
title(xlab="Nodes",line=2,cex.lab=1.2,
      ylab="Computation Time (secs) per Node")
axis(2, at=seq(50,500, by=50), tick=TRUE, labels=FALSE)
axis(2, at=seq(50,500, by=50), tick=FALSE, labels=TRUE, line=-0.5)
axis(1, at=Results[,Node.No], tick=TRUE, labels=FALSE)
axis(1, at=Results[,Node.No], tick=FALSE, labels=TRUE, line=-0.5)
abline(h=Results[Node.No==1][,Avr.Node.Time], col="red")
epsilon = 0.2
segments(Results[,Node.No],Results[,lower],Results[,Node.No],Results[,upper])
segments(Results[,Node.No]-epsilon,Results[,upper],
         Results[,Node.No]+epsilon,Results[,upper])
segments(Results[,Node.No]-epsilon, Results[,lower],
         Results[,Node.No]+epsilon,Results[,lower])
legend('topleft','groups',
       legend=c("Measured", "Expected"), bty="n",lty=c(1,1),
       col=c("blue","red"))
dev.off()

编辑：回应@Hong Ooi的评论

我在UNIX中使用lscpu来获取; 

Architecture:          x86_64
CPU op-mode(s):        32-bit, 64-bit
Byte Order:            Little Endian
CPU(s):                30
On-line CPU(s) list:   0-29
Thread(s) per core:    1
Core(s) per socket:    1
Socket(s):             30
NUMA node(s):          4
Vendor ID:             GenuineIntel
CPU family:            6
Model:                 63
Model name:            Intel(R) Xeon(R) CPU E5-2630 v3 @ 2.40GHz
Stepping:              2
CPU MHz:               2394.455
BogoMIPS:              4788.91
Hypervisor vendor:     VMware
Virtualization type:   full
L1d cache:             32K
L1i cache:             32K
L2 cache:              256K
L3 cache:              20480K
NUMA node0 CPU(s):     0-7
NUMA node1 CPU(s):     8-15
NUMA node2 CPU(s):     16-23
NUMA node3 CPU(s):     24-29

编辑：回应@Steve Weston的评论。

我正在使用虚拟机网络（但我不是管理员）可以访问多达30个群集。我跑了你建议的测试。打开5个R会话并同时在1,2 ... 5上运行矩阵乘法（或者尽可能快地切换并执行）。得到的结果与之前非常相似（重新：每个额外的过程都会减慢所有单个会话的速度）。注意我使用top和htop检查了内存使用情况，使用率从未超过网络容量的5％（~2.5 / 64Gb）。

enter image description here

结论：

问题似乎是R特定的。当我使用其他软件（例如PLINK）运行其他多线程命令时，我不会遇到此问题，并且并行进程按预期运行。我也尝试使用Rmpi和doMPI运行上面相同（较慢）的结果。该问题似乎是虚拟机网络上的相关R会话/并行化命令。我真正需要帮助的是如何查明问题。类似的问题似乎被指出here

2 个答案:

答案 0 :(得分：11)

我发现每个节点的乘法时间非常有趣，因为时序不包括与并行循环相关的任何开销，而只包括执行矩阵乘法的时间，并且它们表明时间随着数字的增加而增加矩阵乘法在同一台机器上并行执行。

我可以想到可能发生这种情况的两个原因：

  1. 在核心耗尽之前，机器的内存带宽已经被矩阵乘法所饱和;
  2. 矩阵乘法是多线程的。

    3. 您可以通过启动多个R会话来测试第一种情况（我在多个终端中执行此操作），在每个会话中创建两个矩阵：

    > x <- matrix(rnorm(4096*4096), 4096)
> y <- matrix(rnorm(4096*4096), 4096)

    然后几乎在同一时间在每个会话中执行矩阵乘法：

    > system.time(z <- x %*% t(y))

    理想情况下，无论您使用的R会话数量（最多为核心数），此时间都是相同的，但由于矩阵乘法是一种内存密集型操作，因此许多计算机在使用之前会耗尽内存带宽耗尽核心，导致时间增加。

    如果您的R安装是使用多线程数学库（如MKL或ATLAS）构建的，那么您可以使用单个矩阵乘法来使用所有内核，因此使用多个进程无法获得更好的性能除非你使用多台电脑。

    您可以使用“top”等工具查看您是否使用多线程数学库。

    最后，lscpu的输出表明您正在使用虚拟机。我从未在多核虚拟机上进行任何性能测试，但这也可能是问题的根源。

    更新

    我认为你的并行矩阵乘法比单个矩阵乘法运行得慢的原因是你的CPU无法足够快地读取内存以便以全速输入超过两个内核，我称之为饱和你的记忆带宽。如果你的CPU有足够大的缓存，你可能可以避免这个问题，但它与你主板上的内存量没有任何关系。

    我认为这只是使用单台计算机进行并行计算的限制。使用群集的一个优点是您的内存带宽和总聚合内存都会增加。因此，如果您在多节点并行程序的每个节点上运行一个或两个矩阵乘法，则不会遇到此特定问题。

    假设您无权访问群集，可以尝试在计算机上对多线程数学库（如MKL或ATLAS）进行基准测试。与在多个进程中并行运行多线程矩阵相比，运行一个多线程矩阵可以获得更好的性能。但是在使用多线程数学库和并行编程包时要小心。

    您也可以尝试使用GPU。他们显然擅长执行矩阵乘法。

    更新2

    为了查看问题是否是R特定的，我建议你对dgemm函数进行基准测试，这是R用来实现矩阵乘法的BLAS函数。

    这是一个简单的Fortran程序，用于标记dgemm。我建议从多个终端执行它，就像我在R：

    中对%*%进行基准测试所描述的那样 
          program main
      implicit none
      integer n, i, j
      integer*8 stime, etime
      parameter (n=4096)
      double precision a(n,n), b(n,n), c(n,n)
      do i = 1, n
        do j = 1, n
          a(i,j) = (i-1) * n + j
          b(i,j) = -((i-1) * n + j)
          c(i,j) = 0.0d0
        end do
      end do
      stime = time8()
      call dgemm('N','N',n,n,n,1.0d0,a,n,b,n,0.0d0,c,n)
      etime = time8()
      print *, etime - stime
      end

    在我的Linux机器上，一个实例在82秒内运行，而四个实例在116秒内运行。这与我在R中看到的结果一致，我猜这是一个内存带宽问题。

    您还可以将其与不同的BLAS库链接，以查看哪种实现在您的计算机上运行得更好。

    您可能还会使用pmbw - Parallel Memory Bandwidth Benchmark获取有关虚拟机网络内存带宽的有用信息，但我从未使用过它。

答案 1 :(得分：2)

我认为这里显而易见的答案是正确的。矩阵乘法并不是令人尴尬的并行。并且您似乎没有修改串行乘法代码来并行化它。

相反，你将两个矩阵相乘。由于每个矩阵的乘法可能仅由单个核处理，因此每个超过2的核只是空闲开销。 结果是您只看到速度提升2倍。

您可以通过运行2个以上的矩阵乘法来测试它。但是我不熟悉foreach，doParallel框架（我使用parallel框架），也没有看到代码中的哪个地方修改它来测试它。

另一种测试是进行矩阵乘法的并行化版本，我直接从Matloff的Parallel Computing for Data Science借用。可用草稿here，请参阅第27页

mmulthread <- function(u, v, w) {
  require(parallel)
  # determine which rows for this thread
  myidxs <- splitIndices(nrow(u), myinfo$nwrkrs ) [[ myinfo$id ]]
  # compute this thread's portion of the result
  w[myidxs, ] <- u [myidxs, ] %*% v [ , ]
  0 # dont return result -- expensive
}
# t e s t on snow c l u s t e r c l s
test <- function (cls,  n = 2^5) {
  # i n i t Rdsm
  mgrinit(cls)
  # shared variables
  mgrmakevar(cls, "a", n, n)
  mgrmakevar(cls, "b", n, n)
  mgrmakevar(cls, "c", n, n)
  # f i l l i n some t e s t data
  a [ , ] <- 1:n
  b [ , ] <- rep (1 ,n)

  # export function
  clusterExport(cls , "mmulthread" )
  # run function
  clusterEvalQ(cls , mmulthread (a ,b ,c ))
  #print ( c[ , ] ) # not p ri n t ( c ) !
}


library(parallel)
library(Rdsm)

c1 <- makeCluster(1)
c2 <- makeCluster (2)
c4 <- makeCluster(4)
c8 <- makeCluster(8)

library(microbenchmark)

microbenchmark(node1= test(c1, n= 2^10),
           node2= test(c2, n= 2^10),
           node4= test(c4, n= 2^10),
           node8= test(c8, n= 2^10))



 Unit: milliseconds
  expr      min       lq     mean   median       uq      max neval  cld
 node1 715.8722 780.9861 818.0487 817.6826 847.5353 922.9746   100    d
 node2 404.9928 422.9330 450.9016 437.5942 458.9213 589.1708   100   c 
 node4 255.3105 285.8409 309.5924 303.6403 320.8424 481.6833   100 a   
 node8 304.6386 328.6318 365.5114 343.0939 373.8573 836.2771   100  b

正如预期的那样，通过并行化矩阵乘法，我们确实看到了我们想要的支出改进，尽管并行开销明显很大。

相关问题
最新问题