Multithreading 空间分布/模拟/密度函数

想象一下，你有一个相当大的数据集，2.000.000点随机分布在一些多边形空间上。 必须随时从随机选择的4000个点的样本中测量密度函数。这个过程必须重复200次。我的代码没有很好地解决这个问题。任何关于如何改进代码的建议

# coord is SpatialPoints Object 
library(sp)
library(maptools)
library(map)

您可以从以下链接获取polygonial对象：

---

germG您可能会发现提前定义一个空白矩阵DG要快一些

除此之外，您可能需要考虑一个多用途的应用程序，授予足够的RAM空间。
 
不是真正的答案，只是一些观察：
如果R=#迭代，S=每次迭代的样本量（例如，R=200，S=4000），那么您的运行时间将是~O（R×S2）。因此，运行次数加倍和样本量减半将使运行时间减少2倍
spDists（…）
中的默认距离度量是欧几里德距离。如果这是您想要的，那么您最好使用
dist（..）
函数-它效率更高（请参见下面的代码）。如果您想要地理距离（例如，大圆），您必须使用
spDists（…，longlat=T）
spDists（…）
计算整个距离矩阵，而不仅仅是下对角线。这意味着所有非零距离都会显示两次，这会对密度产生影响。这就是下面代码中M1和M2不相等的原因
对于大型S，分析代码（使用
Rprof
）显示约46%的时间花在
density（…）
，另外38%的时间花在
spDists（…）
。因此，在这种情况下，用调用to apply、lappy等替换for循环不会有多大帮助
还有其他用于计算地理距离矩阵的函数——假设这是您想要的，但是没有一个函数比您已经使用的更快。我在
fossil
包中尝试了
earth.dist（…）
，
geosphere
包中尝试了
distm（…）
，在
fields
包中尝试了
rdist.earth（…）
，但这些运行时间都没有改进
代码：

库（sp）
图书馆（地图工具）
在代码中添加更多注释总是可以帮助其他人更好地遵循它。还有，最慢的点是什么？您的绩效目标是什么（例如，特定的时间）？@camdixon我通过编辑初始文本添加了更多信息。谢谢你的建议。所以坐标是200万点，但你只有在创建R（200）个采样点和M矩阵之后才开始测量时间。我会从一开始就测量时间，看看创建坐标需要多长时间，然后再测量一次，看看采样需要多长时间。另外，根据你的代码，我不知道你在哪里设置了$y，你能给我解释一下吗？对于多核，如果它是多线程应用程序，它只会利用它们。如果部分线程可以同时运行，请确保在创建多个线程的情况下运行（例如，如果创建了大小为4000的200个样本，我看不出为什么不能让不同的线程分别处理20-40个样本）。当前的进程在多线程的情况下运行得更好。M1和M2中的差异是由bw=“nrd0”（Silverman选择带宽的方法）造成的，如果您修复了h，请将我的代码分析（Rprof）发送到我的电子邮件（和.stepanyan（at）gmail.com）。我试过了，但不幸的是效果不好。另一种提高计算能力的方法是@camdixon尝试拆分处理器内核。我从来没有做过这样的事情，你有过怎样做的经验吗？现在我正在做这件事，如果我能找到任何值得的东西，我也会与你分享。有关分析代码，请参阅我的编辑。我已经删除了配置文件-抱歉。@jlhoward做得很好，我不懂这种语言，所以我帮不了你那么多。你可能知道任何可以分割核心的方法，加快代码性能的方法，就像我的一样。
germG <- readShapePoly("vg250_gem.shp")
coord <- spsample(germG, 2e06, "random") # this command needs some minutes to be done. 

# R is the number of simulations
R <- 200
M <- matrix(NA,R, 256)
ptm=proc.time()
for(r in 1:R) {
  ix <- sample(1:2e06,size=4000)
  Dg <- spDists(coord[ix])
  Dg <- as.vector(Dg[Dg!=0])
  kg <- density(Dg,bw="nrd0",n=256)
  M[r,] <- kg$y
}
runningtime = proc.time()-ptm   
cat("total run time (sec) =",round(runningtime[3],1),"\n") 

library(sp)
library(maptools)
germG <- readShapePoly("vg250_gem.shp")
coord <- spsample(germG, 1e4, "random") # Just 10,000 points...
R <- 200

# dist(...) and spDists(..., longlat=F) give same result
zz <- coord[sample(1e4,size=200)]
d1 <- spDists(zz)
d2 <- dist(zz@coords)
max(abs(as.matrix(d1)-as.matrix(d2)))
# [1] 0
# but dist(...) is much faster
M1 <- matrix(NA,R, 256)
set.seed(1)
system.time({
  for(r in 1:R) {
    ix <- sample(1e4,size=200)    # S = 200; test case
    Dg <- spDists(coord[ix])      # using spDists(...)
    Dg <- as.vector(Dg[Dg!=0])
    kg <- density(Dg,bw="nrd0",n=256)
    M1[r,] <- kg$y
  }
})
#    user  system elapsed 
#   11.08    0.17   11.28 

M2 <- matrix(NA,R, 256)
set.seed(1)
system.time({
  for(r in 1:R) {
    ix <- sample(1e4,size=200)    # S = 200; test case
    Dg <- dist(coord[ix]@coords)  # using dist(...)
    Dg <- as.vector(Dg[Dg!=0])
    kg <- density(Dg,bw="nrd0",n=256)
    M2[r,] <- kg$y
  }
})
# user  system elapsed 
# 2.67    0.03    2.73 

R=200
M <- matrix(NA,R, 256)
Rprof("profile")
set.seed(1)
system.time({
  for(r in 1:R) {
    ix <- sample(1e4,size=200)    # S = 200; test case
    Dg <- spDists(coord[ix])      # using spDists(...)
    Dg <- as.vector(Dg[Dg!=0])
    kg <- density(Dg,bw="nrd0",n=256)
    M[r,] <- kg$y
  }
})
Rprof(NULL)
head(summaryRprof("profile")$by.total,10)
#                   total.time total.pct self.time self.pct
# "system.time"          11.52    100.00      0.02     0.17
# "spDists"               7.08     61.46      0.02     0.17
# "matrix"                6.76     58.68      0.24     2.08
# "apply"                 6.58     57.12      0.26     2.26
# "FUN"                   5.88     51.04      0.22     1.91
# "spDistsN1"             5.66     49.13      3.36    29.17
# "density"               3.18     27.60      0.02     0.17
# "density.default"       3.16     27.43      0.06     0.52
# "bw.nrd0"               1.98     17.19      0.00     0.00
# "quantile"              1.76     15.28      0.02     0.17