2

我继承了 R 的一些代码，它运行得非常慢。大部分时间都花在评估表单的函数上（大约有 15 个这样的函数具有不同的被积函数 G）：

TMin <- 0.5

F <- function (t, d) {
    result <- ifelse(((d > 0) & (t > TMin)),
                     mapply(function(t, d) integrate(G, lower=0, upper=t, t, d)$value, t, d),
                     0)

    return(result)

}

为了测试，我使用以下虚拟函数，但在实际代码中，Gs 更复杂，涉及 exp()、log()、dlnorm()、plnorm() 等。

G <- function(x, t, d) {
    mean(rnorm(1e5))
    x + t - d
}

在最坏的情况下，F 将被计算大约 200 万次。该函数以 3 种不同的方式调用，或者：
t 是单个数字，d 是数字向量，或者，
t 是数字向量，d 是单个数字，或者，
t 是数字向量并且是数字向量

有没有（简单的）方法来加速这个功能？

到目前为止，我已经尝试过（以摆脱 ifelse 循环）的变化：

F2 <- function (t,d) {
    TempRes <- mapply(function(t, d) integrate(G, lower=0, upper=t, t, d)$value, t, d)
    TempRes[(d <= 0) | (t <= TMin)] <- 0
    result <- TempRes

    return(result)
}

和

F3 <- function (t,d) {
    result <- rep(0, max(length(t),length(d)))
    test <- ((d > 0) & (t > TMin))
    result[test] <- mapply(function(t, d) integrate(G, lower=0, upper=t, t, d)$value, t, d)[test]

    return(result)
}

但他们几乎完全相同的时间。

4

2 回答 2

2

您正在执行大量独立集成。您可以通过同时在单独的内核上执行这些集成来加快速度（如果您有可用的多核处理器）。问题是 R 默认以单线程方式执行其计算。但是，有许多可用的包允许多线程支持。我最近在这里和这里回答了一些类似的问题，并提供了一些关于相关包和功能的附加信息。

此外，正如@Mike Dunlavey 已经提到的，您应该避免对不符合您的标准的t和的值执行集成。d（您当前正在对这些值执行不需要的函数评估，然后用 0 覆盖结果）。

我在下面添加了一个可能的改进。请注意，您必须创建一个包含您的函数的单独文件，G以便在集群节点上对其进行评估。在下面的代码中，假设该文件被调用functionG.R

片段：

library(doParallel)
F4 <- function(t,d) {
  results = vector(mode="numeric",max(length=length(t),length(d))) # Zero vector

  logicalVector <- ((d > 0) & (t > TMin))
  relevantT <- t[logicalVector]
  relevantD <- d[logicalVector] # when d is single element, NA values created

  if(length(relevantT) > 1 | length(relevantD) > 1)
  {
    if(length(d)==1) # d is only one element instead of vector --> replicate it
      relevantD <- rep(d,length(relevantT))
    if(length(t)==1) # t is only one element instead of vector --> replicate it
      relevantT <- rep(t,length(relevantD))

    cl <- makeCluster(detectCores()); 
    registerDoParallel(cl)
    clusterEvalQ(cl,eval(parse("functionG.R")))

    integrationResults <- foreach(i=1:length(relevantT),.combine="c") %dopar%
    {
      integrate(G,lower=0,upper=relevantT[i],relevantT[i],relevantD[i])$value;
    }
    stopCluster(cl)
    results[logicalVector] <- integrationResults
  }
  else if(length(relevantT==1)) # Cluster overhead not needd
  {
    results[logicalVector] = integrate(G,lower=0,upper=relevantT,relevantT,relevantD)$value;
  }

  return(results)
}

我的 CPU 包含 6 个启用超线程的物理内核 (x2)。这些是结果：

> t = -5000:20000
> d = -5000:20000
> 
> start = Sys.time()
> testF3 = F3(t,d)
> timeNeededF3 = Sys.time()-start
> 
> start = Sys.time()
> testF4 = F4(t,d)
> timeNeededF4 = Sys.time()-start;

> timeNeededF3
Time difference of 3.452825 mins
> timeNeededF4
Time difference of 29.52558 secs
> identical(testF3,testF4)
[1] TRUE

运行此代码时，内核似乎一直在使用。但是，您可以通过在内核周围更有效地预拆分数据来进一步优化此代码，然后在单独的内核上使用应用类型函数。

如果需要更多优化，您还可以更深入地了解该integrate功能。您可以通过允许不太严格的数值近似来调整设置并获得性能提升。作为替代方案，您可以实现自己的简单版本的自适应辛普森正交并使用离散步长。很可能您可以获得像这样的大量性能提升（如果您能够/愿意在近似值中允许更多错误）。

编辑： 更新代码以使其适用于所有场景：d和/或t有效/无效数字或向量

回复评论 @mawir：你是对的。ifelse(test, yes, no)将为yestest 计算结果的行返回相应的值TRUE，它将返回计算结果为的行的相应no值。但是，它首先必须评估您的表达式才能创建. 这段代码演示了这一点：testFALSEyesyeslength(test)

> t = -5000:5
> d = -5000:5
> 
> start = Sys.time()
> testF1 = F(t,d)
> timeNeededF1 = Sys.time()-start
> timeNeededF1
Time difference of 43.31346 secs
> 
> start = Sys.time()
> testF4 = F4(t,d)
> timeNeededF4 = Sys.time()-start
> timeNeededF4
Time difference of 2.284134 secs

t在这种情况下，只有 和 的最后 5 个值d是相关的。但是，在F1函数内部，为了创建向量，首先ifelse评估mapply所有d和值。这就是函数执行需要这么长时间的原因。接下来，它选择满足条件的元素，否则为 0。该功能可解决此问题。tyesF4

此外，您说您在t和d是非向量的情况下获得加速。但是，在这种情况下，没有使用并行化。t您通常应该在其中一个或两个/d是向量的情况下获得最大加速。

另一个编辑，以回应 Roland 的评论：如果您不想创建单独的函数文件，您可能会clusterEvalQ(cl,eval(parse("functionG.R")))替换为。clusterExport(cl,"G")

于 2015-06-20T21:46:21.540 回答
0

一般来说，要查看的位置位于最内层循环中，您可以通过缩短时间或减少调用次数来加快速度。您有一个内部循环 running mapply，但随后您从中提取元素[test]。这是否意味着所有其他元素都被丢弃了？如果是这样，为什么还要花时间计算额外的元素呢？

于 2015-06-20T13:02:32.340 回答