Question

我继承了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)
}

但它们几乎完全相同。

Answer 1

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

此外，正如@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功能。您可以通过允许不太严格的数值近似来使用设置并获得性能增益。作为替代方案，您可以实现自己的简单版本的自适应Simpson正交，并使用离散步长。最有可能的是你可以获得如此大规模的性能提升（如果你能够/愿意在近似中允许更多的错误）。

修改更新了代码，以使其适用于所有情况：d和/或t有效/无效的数字或向量

回复评论 @mawir：你是对的。 ifelse(test, yes, no)将为测试评估为yes的行返回相应的TRUE值，它将返回no评估的行的相应test值到FALSE。但是，它首先必须评估您的yes表达式，以便创建yes length(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和d的最后5个值相关。但是，在F1函数内，ifelse首先评估所有mapply和d值的t，以便创建yes向量。这就是函数执行需要很长时间的原因。接下来，它选择满足条件的元素，否则为0。 F4函数适用于此问题。

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

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

Answer 2

作为一般性，要看的地方是在最里面的循环中，你可以通过减少花费更少的时间或通过调用它来加快速度。你有一个运行mapply的内循环，但是从中提取元素[test]。这是否意味着所有其他元素都被丢弃了？如果是这样，为什么还要花时间计算额外的元素？

加快涉及mapply和整合的功能

2 个答案: