加速涉及mapply和integrate的函数

我继承了一些代码，它运行得非常慢。大部分时间用于计算形式的函数（大约有15个具有不同被积函数G的函数）：

---

TMin一般来说，查看的地方是最内部的循环，您可以通过减少时间或调用次数来加快速度。您有一个运行
mapply
的内部循环，但随后从中提取元素
[test]
。这是否意味着所有其他元素都被丢弃？如果是这样，为什么还要花时间计算额外的元素呢？
您正在执行大量的独立积分。您可以通过同时在不同的内核上执行这些集成来加快速度（如果您有多核处理器可用）。问题在于，默认情况下，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)
}

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

如果需要进行更多优化，您还可以深入了解
integrate
函数。通过允许不太严格的数值近似，您可以潜在地使用这些设置并获得性能增益。作为替代方案，您可以实现自己的简单版本的自适应辛普森求积，并使用离散步长。最有可能的情况是，您可以像这样获得巨大的性能提升（如果您能够/愿意在近似值中允许更多的错误）

编辑：
已更新代码，以便其在所有场景中工作：
d
和/或
t
有效/无效数字或向量

回复评论
@马维尔：你说得对
ifelse（test，yes，no）
将为测试结果为
TRUE
的行返回相应的
yes
值，它将为
测试结果为
FALSE
的行返回相应的
no
值。但是，为了创建
length（test）
的
yes
向量，它必须首先计算
yes
表达式。这段代码演示了这一点：

> 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
首先对所有
d
和
t
值计算
mappy
，以创建
yes
向量。这就是函数执行时间如此之长的原因。接下来，它选择满足条件的元素，否则选择0。
F4
功能可解决此问题

此外，您还可以说在
t
和
d
为非向量的情况下获得加速比。然而，在这种情况下，没有使用并行化。通常，您应该在senario中获得最大加速比，其中一个或两个
t
/
d
为矢量

另一次编辑，回应罗兰的评论：
如果您不想创建单独的函数文件，您可以用
clusterExport（cl，“G”）
替换
clusterEvalQ（cl，eval（parse（“functionG.R”））
。
您确定积分没有闭合形式的解吗？因为到目前为止，你有最好的潜力来提高性能。如果你的数学技能不熟练，你可以问一个CAS。而且，像往常一样，如果你对性能不满意，请分析你的代码。如果有一个封闭的，但你是对的，这值得一看。这可能是个坏主意，但你可以尝试将15个函数合并成一个向量值函数，并使用容积软件包中的
自适应积分
。它在一维上比R的积分慢，但在处理向量值函数方面有优势。如果你以后想用一种更快的语言编写你的被积函数的话，它就是…；return（result）
在R中真的没有意义：函数的最后一个表达式自动是函数的结果。不需要将其分配给变量，也不需要
return
。我不明白这一点。我认为迈克·邓拉维的观点是，我尝试的解决方案至少需要与原始函数一样长的时间，因为它们在理论上做完全相同的计算，然后花额外的时间过滤结果。我尝试了它们，因为我不知道ifelse（）在“幕后”做什么（以及做这件事需要多少时间）。我知道ifelse在“幕后”做什么，这不是你的瓶颈。如果你分析了你的代码，你就会看到这一点。@Roland:我指的是OP的函数
F3
，它执行
mapply
，后面跟着
[test]
。这看起来像是在构建一个列表/数组，只取一个元素，然后丢弃其余的元素（以及创建它所花费的精力）。
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)
}

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)
}

> 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

> 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