在R中加速模拟（附示例）

这个问题是我的后续问题

我获得两个随机样本，计算成对距离，并得到它们的平均值。然后，我重复多次，并将平均值存储到一个向量中

（我感谢docendo discimus计算距离的“半矢量化”方法。）

---

问题：这里的模拟数量只有100个。事实上，我需要将模拟的数量增加到1000。2000年会更好。有加快速度的余地吗？我目前正在研究一些并行计算技术。顺便说一句，我担心

apply

类型的方法会消耗大量的RAM，并且对于具有大量模拟的大数据可能不可行。

对于冗长的回答，我深表歉意，但这里有很多事情要做。首先，做些家务

在外循环的每次迭代中，您似乎想要计算大小为4000和5000的两个随机样本的所有成对距离的平均值（因此，2000万距离的平均值）。但您的代码并没有做到这一点

distfunc（…）

返回长度为5000的向量。当您尝试将其设置为

distvector[i]

时，您将丢弃除第一个距离以外的所有距离（这就是为什么会收到所有这些警告）。因此，在每一步中，您都要计算5000个距离，丢弃其中4999个，并重复该过程4000次。我只能假设这不是你的目标，所以在下面的代码中我改变了这一点

另外，您的

distfunc（…）

看起来像哈弗森距离公式的实现，但它不是。哈弗森公式要求以弧度表示的long/lat，但你（似乎…）以度表示通过long/lat。结果之一是，您的结果和使用R内置的

distHaversine（…）

（在

geoshpere

包中）或

spDistsN1（…）

（在

sp

包中）得到的结果是不可比的。我不清楚您到底想实现什么，所以我没有更改您的

distfunc（…）

，但您可能不得不这样做

现在来看看如何加速这个问题

在这种情况下，分析代码几乎总是有用的。您可以使用

Rprof（）

和

summaryRprof（）

来执行此操作

因此，对于示例中的100次迭代，仅计算sin/cos值就需要430秒。当然，这些函数都是完全矢量化的，并且是用C编写的，所以您不可能在这方面有太多改进。原则上，一种选择是编写一个版本的

distfunc（…）

以C计算所有2000万个距离，然后使用

Rcpp

包调用它。事实上，你先前问题的一个答案就是这样的。你试过了吗

另一种选择是并行处理。下面是一种使用多核实现算法的方法。看起来你有一个双核系统，所以这可能对你没有多大帮助

# your solution (slightly modified)
system.time({
  distvector <- numeric(nsample1)
  meandistv  <- numeric(nsampling)
  for (n in seq_len(nsampling)) { # loop for simulation
    sample1 <- pop[sample(npop,nsample1),]
    sample2 <- pop[sample(npop,nsample2),]
    for (i in seq_len(nsample1)) {
      distvector[i] <- mean(distfunc(sample2[,1],sample2[,2],sample1[i,1],sample1[i,2]))
    }
    meandistv[n] <- mean(distvector)
  }
})
#    user  system elapsed 
#  551.06    0.13  554.70 

# parallel processing solution
library(foreach)   # for foreach(...)
library(snow)      # for makeCluster(...)
library(doSNOW)    # for resisterDoSNOW(...)

cl <- makeCluster(8,type="SOCK")  # create cluster
registerDoSNOW(cl)                # register the cluster

system.time({
  meandistv <- foreach(n=seq(nsampling), .inorder=FALSE, .packages=c("foreach","iterators"), .combine=c) %dopar% {
    sample1 <- pop[sample(nrow(pop),nsample1),]
    sample2 <- pop[sample(nrow(pop),nsample2),]
    dists   <- foreach(row=iter(sample1,by="row")) %do% {
      mean(distfunc(sample2[,1],sample2[,2],row[1],row[2]))
    }
    mean(unlist(dists))
  }
})
#    user  system elapsed 
#    0.30    0.06  224.94 
stopCluster(cl)

#您的解决方案（稍加修改）
系统时间({
distvector不查看详细信息：预先分配结果向量。例如，
distvector Right。谢谢，罗兰。您是否尝试过用data.table交叉联接替换这些循环？然后您可以使用：=运算符按行计算第五列中的距离。太糟糕了，这被标记为重复。我查看了另一个答案d这对你的情况没有任何帮助。看起来你在计算哈弗森距离。在R中有一些包可能更快，当然可以避免所有这些循环。在
geosphere
包中看一看
distHaversine（…）
。然后，类似于
mean（应用）（样本1,1，函数（行））的东西distHaversine（row，sample2））
将替换内部循环。如果问题没有被禁止，我可以给你一个更好的答案。@jlhoward我已经重新打开了它。请随意发布答案。
> proc.time() - ptm
   user  system elapsed 
 629.74    0.14  632.35

Rprof()
nsampling <- 10   # just ten simulations...
distvector <- numeric(nsample1)
meandistv  <- numeric(nsampling)
for (n in seq_len(nsampling)) { # loop for simulation
  sample1 <- pop[sample(npop,nsample1),]
  sample2 <- pop[sample(npop,nsample2),]
  for (i in seq_len(nsample1)) {
    # note change: mean(distfunc(...)), not distfunc(...)
    distvector[i] <- mean(distfunc(sample1[i,1],sample1[i,2],sample2[,1],sample2[,2]))
  }
  meandistv[n] <- mean(distvector)
}  
summaryRprof()
# ...
# $by.total
#                    total.time total.pct self.time self.pct
# "mean"                  36.46     99.95      0.50     1.37
# "distfunc"              35.68     97.81      3.88    10.64
# "sin"                   11.84     32.46     11.84    32.46
# "cos"                    7.44     20.39      7.44    20.39
# "pmin"                   7.18     19.68      5.00    13.71

X <- rnorm(4000*5000*4)
system.time(sin(X))
#    user  system elapsed 
#    4.25    0.09    4.35 

# your solution (slightly modified)
system.time({
  distvector <- numeric(nsample1)
  meandistv  <- numeric(nsampling)
  for (n in seq_len(nsampling)) { # loop for simulation
    sample1 <- pop[sample(npop,nsample1),]
    sample2 <- pop[sample(npop,nsample2),]
    for (i in seq_len(nsample1)) {
      distvector[i] <- mean(distfunc(sample2[,1],sample2[,2],sample1[i,1],sample1[i,2]))
    }
    meandistv[n] <- mean(distvector)
  }
})
#    user  system elapsed 
#  551.06    0.13  554.70 

# parallel processing solution
library(foreach)   # for foreach(...)
library(snow)      # for makeCluster(...)
library(doSNOW)    # for resisterDoSNOW(...)

cl <- makeCluster(8,type="SOCK")  # create cluster
registerDoSNOW(cl)                # register the cluster

system.time({
  meandistv <- foreach(n=seq(nsampling), .inorder=FALSE, .packages=c("foreach","iterators"), .combine=c) %dopar% {
    sample1 <- pop[sample(nrow(pop),nsample1),]
    sample2 <- pop[sample(nrow(pop),nsample2),]
    dists   <- foreach(row=iter(sample1,by="row")) %do% {
      mean(distfunc(sample2[,1],sample2[,2],row[1],row[2]))
    }
    mean(unlist(dists))
  }
})
#    user  system elapsed 
#    0.30    0.06  224.94 
stopCluster(cl)